Thread: Change Macro
View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Alen32[_2_] Alen32[_2_] is offline
external usenet poster
 
Posts: 1
Default Change Macro


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