Change Macro

**Alen32** · 03-06-2006, 07:27 AM

Hej!
I have makro which open and update file 150.xls and makro works well. I need to change makro so I can update at same time files 180.xls, 200.xls, 210.xls, 250.xls and 300.xls.
here is macro:
Private Sub CommandButton1_Click()

Const sSalesFile As String = "C:\150.xls"
Const sSalesSheetName As String = "Ark1"
Const sCellToWriteIn As String = "AF3"

Dim wkbNew As Excel.Workbook
Dim wkbSales As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim wksView As Excel.Worksheet
Dim lRowFrom As Long
Dim lRowTo As Long
Dim bFound As Boolean

'On Error GoTo CleanUp
Set wkbNew = ActiveWorkbook
Set wksImport = wkbNew.ActiveSheet
Set wkbSales = Application.Workbooks.Open(Filename:=sSalesFile)
Set wksView = wkbSales.Worksheets(sSalesSheetName)

' 2-tallet her bestemmer hvilken række det første kundenr findes i (Update-filen)
For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
bFound = False

' 3-tallet her bestemmer hvilken række det første kundenr findes i (Salgsview-filen)
For lRowTo = 3 To wksView.UsedRange.Rows.Count

If Val(wksImport.Cells(lRowFrom, 1).Value) = _
wksView.Cells(lRowTo, 2).Value Then

wksView.Cells(lRowTo, wksView.Range(sCellToWriteIn).Column).Value = _
wksImport.Cells(lRowFrom, 2).Value
bFound = True
Exit For

End If

Next lRowTo

If Not bFound Then
'Cellen bliver rød, hvis ikke den er overført til opsummeringsarket
wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
End If
Next lRowFrom

CleanUp:
Set wksImport = Nothing
Set wksView = Nothing
Set wkbNew = Nothing
Set wkbSales = Nothing

End Sub

Bob Phillips · 03-06-2006, 09:10 AM

Untested, but try this

Private Sub CommandButton1_Click()

DoMyStuff "C:\150.xls"
DoMyStuff "C:\180.xls"
DoMyStuff "C:\200.xls"
DoMyStuff "C:\210.xls"
DoMyStuff "C:\250.xls"
DoMyStuff "C:\300.xls"

End Sub

Private Sub DoMyStuff(FileName As String)
Const sSalesSheetName As String = "Ark1"
Const sCellToWriteIn As String = "AF3"

Dim wkbNew As Excel.Workbook
Dim wkbSales As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim wksView As Excel.Worksheet
Dim lRowFrom As Long
Dim lRowTo As Long
Dim bFound As Boolean

'On Error GoTo CleanUp
Set wkbNew = ActiveWorkbook
Set wksImport = wkbNew.ActiveSheet
Set wkbSales = Application.Workbooks.Open(FileName:=FileName)
Set wksView = wkbSales.Worksheets(sSalesSheetName)

' 2-tallet her bestemmer hvilken række det første
' kundenr findes i(Update-filen)
For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
bFound = False

' 3-tallet her bestemmer hvilken række det første kundenr
findes i(Salgsview - filen)
For lRowTo = 3 To wksView.UsedRange.Rows.Count

If Val(wksImport.Cells(lRowFrom, 1).Value) = _
wksView.Cells(lRowTo, 2).Value Then

wksView.Cells(lRowTo, wksView.Range(sCellToWriteIn).Column).Value = _
wksImport.Cells(lRowFrom, 2).Value
bFound = True
Exit For

End If

Next lRowTo

If Not bFound Then
'Cellen bliver rød, hvis ikke den er overført til
opsummeringsarket
wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
End If
Next lRowFrom

CleanUp:
Set wksImport = Nothing
Set wksView = Nothing
Set wkbNew = Nothing
Set wkbSales = Nothing

End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Alen32" <[email protected]> wrote in
message news:[email protected]...
>
> Hej!
> I have makro which open and update file 150.xls and makro works well. I
> need to change makro so I can update at same time files 180.xls,
> 200.xls, 210.xls, 250.xls and 300.xls.
> here is macro:
> Private Sub CommandButton1_Click()
>
> Const sSalesFile As String = "C:\150.xls"
> Const sSalesSheetName As String = "Ark1"
> Const sCellToWriteIn As String = "AF3"
>
> Dim wkbNew As Excel.Workbook
> Dim wkbSales As Excel.Workbook
> Dim wksImport As Excel.Worksheet
> Dim wksView As Excel.Worksheet
> Dim lRowFrom As Long
> Dim lRowTo As Long
> Dim bFound As Boolean
>
> 'On Error GoTo CleanUp
> Set wkbNew = ActiveWorkbook
> Set wksImport = wkbNew.ActiveSheet
> Set wkbSales = Application.Workbooks.Open(Filename:=sSalesFile)
> Set wksView = wkbSales.Worksheets(sSalesSheetName)
>
> ' 2-tallet her bestemmer hvilken række det første kundenr findes i
> (Update-filen)
> For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
> bFound = False
>
> ' 3-tallet her bestemmer hvilken række det første kundenr
> findes i (Salgsview-filen)
> For lRowTo = 3 To wksView.UsedRange.Rows.Count
>
> If Val(wksImport.Cells(lRowFrom, 1).Value) = _
> wksView.Cells(lRowTo, 2).Value Then
>
> wksView.Cells(lRowTo,
> wksView.Range(sCellToWriteIn).Column).Value = _
> wksImport.Cells(lRowFrom, 2).Value
> bFound = True
> Exit For
>
> End If
>
> Next lRowTo
>
> If Not bFound Then
> 'Cellen bliver rød, hvis ikke den er overført til
> opsummeringsarket
> wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
> End If
> Next lRowFrom
>
>
> CleanUp:
> Set wksImport = Nothing
> Set wksView = Nothing
> Set wkbNew = Nothing
> Set wkbSales = Nothing
>
> End Sub
>
>
> --
> Alen32
> ------------------------------------------------------------------------
> Alen32's Profile:
http://www.excelforum.com/member.php...o&userid=32181
> View this thread: http://www.excelforum.com/showthread...hreadid=519279
>

Patrick Molloy · 03-06-2006, 09:10 AM

change this line

Const sSalesFile As String = "C:\150.xls"

to
DIM sSalesFile As String

now it depends where yuo want the file name, eg
on sheet 'config' cell B2

sSalesFile = Worksheets("config").Range("B2")
"Alen32" wrote:

>
> Hej!
> I have makro which open and update file 150.xls and makro works well. I
> need to change makro so I can update at same time files 180.xls,
> 200.xls, 210.xls, 250.xls and 300.xls.
> here is macro:
> Private Sub CommandButton1_Click()
>
> Const sSalesFile As String = "C:\150.xls"
> Const sSalesSheetName As String = "Ark1"
> Const sCellToWriteIn As String = "AF3"
>
> Dim wkbNew As Excel.Workbook
> Dim wkbSales As Excel.Workbook
> Dim wksImport As Excel.Worksheet
> Dim wksView As Excel.Worksheet
> Dim lRowFrom As Long
> Dim lRowTo As Long
> Dim bFound As Boolean
>
> 'On Error GoTo CleanUp
> Set wkbNew = ActiveWorkbook
> Set wksImport = wkbNew.ActiveSheet
> Set wkbSales = Application.Workbooks.Open(Filename:=sSalesFile)
> Set wksView = wkbSales.Worksheets(sSalesSheetName)
>
> ' 2-tallet her bestemmer hvilken rÃ¦kke det fÃ¸rste kundenr findes i
> (Update-filen)
> For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
> bFound = False
>
> ' 3-tallet her bestemmer hvilken rÃ¦kke det fÃ¸rste kundenr
> findes i (Salgsview-filen)
> For lRowTo = 3 To wksView.UsedRange.Rows.Count
>
> If Val(wksImport.Cells(lRowFrom, 1).Value) = _
> wksView.Cells(lRowTo, 2).Value Then
>
> wksView.Cells(lRowTo,
> wksView.Range(sCellToWriteIn).Column).Value = _
> wksImport.Cells(lRowFrom, 2).Value
> bFound = True
> Exit For
>
> End If
>
> Next lRowTo
>
> If Not bFound Then
> 'Cellen bliver rÃ¸d, hvis ikke den er overfÃ¸rt til
> opsummeringsarket
> wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
> End If
> Next lRowFrom
>
>
> CleanUp:
> Set wksImport = Nothing
> Set wksView = Nothing
> Set wkbNew = Nothing
> Set wkbSales = Nothing
>
> End Sub
>
>
> --
> Alen32
> ------------------------------------------------------------------------
> Alen32's Profile: http://www.excelforum.com/member.php...o&userid=32181
> View this thread: http://www.excelforum.com/showthread...hreadid=519279
>
>

**Alen32** · 03-06-2006, 09:45 AM

There is some problems
Macro open and update file 150.xls, but macro only open file180.xls without updating.

And there is another problem : Macro should paint cells which values are not transfered.
Private Sub CommandButton1_Click()
'Private Sub CommandButton1_Click()

DoMyStuff "C:\150.xls"
DoMyStuff "C:\180.xls"
'DoMyStuff "C:\200.xls"
'DoMyStuff "C:\210.xls"
'DoMyStuff "C:\250.xls"
'DoMyStuff "C:\300.xls"

End Sub

Private Sub DoMyStuff(FileName As String)
Const sSalesSheetName As String = "Ark1"
Const sCellToWriteIn As String = "AF3"

Dim wkbNew As Excel.Workbook
Dim wkbSales As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim wksView As Excel.Worksheet
Dim lRowFrom As Long
Dim lRowTo As Long
Dim bFound As Boolean

'On Error GoTo CleanUp
Set wkbNew = ActiveWorkbook
Set wksImport = wkbNew.ActiveSheet
Set wkbSales = Application.Workbooks.Open(FileName:=FileName)
Set wksView = wkbSales.Worksheets(sSalesSheetName)

' 2-tallet her bestemmer hvilken række det første
' kundenr findes i(Update-filen)
For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
bFound = False

' 3-tallet her bestemmer hvilken række det første kundenr
'findes i(Salgsview - filen)
For lRowTo = 3 To wksView.UsedRange.Rows.Count

If Val(wksImport.Cells(lRowFrom, 1).Value) = _
wksView.Cells(lRowTo, 2).Value Then

wksView.Cells(lRowTo, wksView.Range(sCellToWriteIn).Column).Value = _
wksImport.Cells(lRowFrom, 2).Value
bFound = True
Exit For

End If

Next lRowTo

If Not bFound Then
'Cellen bliver rød, hvis ikke den er overført tilm opsummeringsarket
wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
End If
Next lRowFrom

CleanUp:
Set wksImport = Nothing
Set wksView = Nothing
Set wkbNew = Nothing
Set wkbSales = Nothing

End Sub

'End Sub
Private Sub CommandButton2_Click()
Const sSalesFile As String = "C:\180.xls"
Const sSalesSheetName As String = "Ark1"
Const sCellToWriteIn As String = "AF3"

Dim wkbNew As Excel.Workbook
Dim wkbSales As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim wksView As Excel.Worksheet
Dim lRowFrom As Long
Dim lRowTo As Long
Dim bFound As Boolean

'On Error GoTo CleanUp
Set wkbNew = ActiveWorkbook
Set wksImport = wkbNew.ActiveSheet
Set wkbSales = Application.Workbooks.Open(FileName:=sSalesFile)
Set wksView = wkbSales.Worksheets(sSalesSheetName)

' 2-tallet her bestemmer hvilken række det første kundenr findes i (Update-filen)
For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
bFound = False

' 3-tallet her bestemmer hvilken række det første kundenr findes i (Salgsview-filen)
For lRowTo = 3 To wksView.UsedRange.Rows.Count

If Val(wksImport.Cells(lRowFrom, 1).Value) = _
wksView.Cells(lRowTo, 2).Value Then

wksView.Cells(lRowTo, wksView.Range(sCellToWriteIn).Column).Value = _
wksImport.Cells(lRowFrom, 2).Value
bFound = True
Exit For

End If

Next lRowTo

If Not bFound Then
'Cellen bliver rød, hvis ikke den er overført til opsummeringsarket
wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
End If
Next lRowFrom

CleanUp:
Set wksImport = Nothing
Set wksView = Nothing
Set wkbNew = Nothing
Set wkbSales = Nothing
End Sub

Ardus Petus · 03-06-2006, 10:00 AM

Try this, which I could not test.

HTH
--
AP

'------------------------------------------------
Private Sub CommandButton1_Click()

Const sSalesSheetName As String = "Ark1"
Const sCellToWriteIn As String = "AF3"

Dim salesFile(1 To 5)
salesFile(1) = "C:\180.xls"
salesFile(2) = "C:\180.xls"
salesFile(3) = "C:\200.xls"
salesFile(4) = "C:\210.xls"
salesFile(5) = "C:\250.xls"

Dim iSalesNo As Integer
Dim wkbNew As Excel.Workbook
Dim wkbSales As Excel.Workbook
Dim wksImport As Excel.Worksheet
Dim wksView As Excel.Worksheet
Dim lRowFrom As Long
Dim lRowTo As Long
Dim bFound As Boolean

'On Error GoTo CleanUp
Set wkbNew = ActiveWorkbook
Set wksImport = wkbNew.ActiveSheet

For iSalesNo = LBound(salesFile) To UBound(salesFile)
Set wkbSales = Application.Workbooks.Open( _
Filename:=salesFile(iSalesNo))
Set wksView = wkbSales.Worksheets(sSalesSheetName)

' 2-tallet her bestemmer hvilken
' række det første kundenr findes i( Update-filen)
For lRowFrom = 2 To wksImport.UsedRange.Rows.Count
bFound = False
' 3-tallet her bestemmer hvilken række
' det første kundenrfindes i(Salgsview - filen)
For lRowTo = 3 To wksView.UsedRange.Rows.Count
If Val(wksImport.Cells(lRowFrom, 1).Value) = _
wksView.Cells(lRowTo, 2).Value Then
wksView.Cells( _
lRowTo, _
wksView.Range(sCellToWriteIn).Column _
).Value = _
wksImport.Cells(lRowFrom, 2).Value
bFound = True
Exit For
End If
Next lRowTo

If Not bFound Then
'Cellen bliver rød,
'hvis ikke den er overført til opsummeringsarket
wksImport.Cells(lRowFrom, 1).Interior.ColorIndex = 3
End If
Next lRowFrom
Next iSalesNo

CleanUp:
Set wksImport = Nothing
Set wksView = Nothing
Set wkbNew = Nothing
Set wkbSales = Nothing

End Sub

"Alen32" <[email protected]> a écrit dans
le message de news:[email protected]...
>
> Hej!
> I have makro which open and update file 150.xls and makro works well. I
> need to change makro so I can update at same time files 180.xls,
> 200.xls, 210.xls, 250.xls and 300.xls.
>