Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change Macro
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change Macro
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" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change Macro
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 -- Alen32 ------------------------------------------------------------------------ Alen32's Profile: http://www.excelforum.com/member.php...o&userid=32181 View this thread: http://www.excelforum.com/showthread...hreadid=519279 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change Macro
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" a écrit dans le message de ... 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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Use Macro To Change Which Macro Assigned To Command Button | Excel Discussion (Misc queries) | |||
Insert row at change macro - how to change it. | Excel Discussion (Misc queries) | |||
macro that will change the font of a cell if i change a value | Excel Discussion (Misc queries) | |||
Cell value change to trigger macro (worksheet change event?) | Excel Programming | |||
Macro to change Macro code? | Excel Programming |