Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Matching in VBA
Thanks for your help - I think it has got me a step in the right direction -
however, it still does not appear to be working. Can anyone suggest a modification to the code to make it work. The code as it stands at the moment is as follows: Dim strWSName As String Dim ws As Worksheet done = False Windows("Cancer monitoring (Commissioner).xls").Activate For Each ws In ActiveWorkbook.Worksheets 'match the left four characters of the filename and sheet name If Left(ws.Name, 4) = Left(wbdatafile.Name, 4) Then wbdatafile.Open Range("A2").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy ThisWorkbook.Activate strWSName = wbdatafile.Name If SheetExists = True Then Worksheets(strWSName).Activate Range("B65536").End(xlUp).Offset(1, -1).Select ActiveSheet.Paste Range("B65536").End(xlUp).Offset(1, -1).Select wbdatafile.Activate ActiveWorkbook.Close done = True Exit For End If End If Next Thanks for your anticipated help! "sali" wrote: "BoRed79" je napisao u poruci interesnoj ... Hi All. Can anyone please offer some advice on where I might start to create a macro to solve the following problem: I have a series of xls files containing data each with a prefix of 1.1, 1.2, 1.3 etc. I want to take the data from each of these files in turn and paste it into a master spreadsheet. In the spreadsheet there are sheets with names that match the prefix of the downloads e.g. 1.1, 1.2, 1.3 etc. I need to macro to match up the xls file name to the sheet name to determine where it pastes the data. I have code to enable it to copy and paste the data into the sheets - but not the functionality to match the data to the correct sheets. here is the main loop, just insert you copy/paste sheet code in the match place ---- done = false for each ws in master.sheets if ws.name = wbdatafile.name then 'sheet match - copy from wb data file to master sheet done = true exit for end if next if not done then msgbox "not matched, not pasted!" end if ---- . |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Matching in VBA
"BoRed79" je napisao u poruci interesnoj
... Thanks for your help - I think it has got me a step in the right direction - however, it still does not appear to be working. Can anyone suggest a modification to the code to make it work. The code as it stands at the I have code to enable it to copy and paste the data into the sheets - but not the functionality to match the data to the correct sheets. here is the main loop, just insert you copy/paste sheet code in the match place ---- done = false for each ws in master.sheets if ws.name = wbdatafile.name then 'sheet match - copy from wb data file to master sheet done = true exit for end if next if not done then msgbox "not matched, not pasted!" end if ---- i can't see what is the your code layout, something like: 1] open master file 2] open *all* of the data files 3] start a loop processing one-by-one data file 4] target curent data file 5] do a data-file/master-sheet matching as described 6] if matched, do a copy/paste, otherwise alert of invalid data-file 7] target next data file, until loop 3] exhausted 8] close data-files, save master, eventualy generate report of success if you agree on this model [or present your own], we may try to improve your code to became functional |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Matching in VBA
Hi.
The model that you have suggested appears to be a very sensible approach to the problem - however - I am not really sure where to start in modifying my code to make this happen. Liz. "sali" wrote: "BoRed79" je napisao u poruci interesnoj ... Thanks for your help - I think it has got me a step in the right direction - however, it still does not appear to be working. Can anyone suggest a modification to the code to make it work. The code as it stands at the I have code to enable it to copy and paste the data into the sheets - but not the functionality to match the data to the correct sheets. here is the main loop, just insert you copy/paste sheet code in the match place ---- done = false for each ws in master.sheets if ws.name = wbdatafile.name then 'sheet match - copy from wb data file to master sheet done = true exit for end if next if not done then msgbox "not matched, not pasted!" end if ---- i can't see what is the your code layout, something like: 1] open master file 2] open *all* of the data files 3] start a loop processing one-by-one data file 4] target curent data file 5] do a data-file/master-sheet matching as described 6] if matched, do a copy/paste, otherwise alert of invalid data-file 7] target next data file, until loop 3] exhausted 8] close data-files, save master, eventualy generate report of success if you agree on this model [or present your own], we may try to improve your code to became functional . |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Matching in VBA
"BoRed79" je napisao u poruci interesnoj
... the problem - however - I am not really sure where to start in modifying my if it helps, try posting here the whole code, like copy/paste |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Matching in VBA
The whole code is as follows:
'32-bit API declarations (BT) Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Public Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Sub Commissioner() 'Switch off screen flashing Application.ScreenUpdating = False 'Turn off auto calculation With Application .Calculation = xlManual .MaxChange = 0.001 End With ActiveWorkbook.PrecisionAsDisplayed = False 'Request the user to select the folder containing the latest commissioner data Msg = "Select the folder containing the latest COMMISSIONER data" DDirectory = GetDirectory(Msg) If DDirectory = "" Then Exit Sub If Right(DDirectory, 1) < "\" Then DDirectory = DDirectory & "\" a = MsgBox(Prompt:=DDirectory, Buttons:=vbOKOnly) 'Open each text file and save it as an excel file ChDir DDirectory Set fso = CreateObject("Scripting.FileSystemObject").GetFold er(DDirectory) For Each file In fso.Files If file.Type = "Text Document" Then With file Workbooks.OpenText Filename:=file.Name _ , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), _ Array(16, 1), Array(17, 1), Array(18, 1)), TrailingMinusNumbers:=True ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Name & ".xls" _ , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close End With End If Next Set fso = Nothing 'Unhide all worksheets Sheets("6.1 ReportDownload").Visible = True Sheets("6.2 ReportDownload").Visible = True Sheets("7.1 ReportDownload").Visible = True Sheets("7.2 ReportDownload").Visible = True Sheets("7.7 ReportDownload").Visible = True Sheets("7.8 ReportDownload").Visible = True Sheets("8.1 ReportDownload").Visible = True Sheets("8.2 ReportDownload").Visible = True Sheets("8.7 ReportDownload").Visible = True Sheets("9.1 ReportDownload").Visible = True Sheets("9.2 ReportDownload").Visible = True Sheets("10.1 ReportDownload").Visible = True Sheets("10.2 ReportDownload").Visible = True 'Open each Excel file and copy it into the model Dim strWSName As String Dim ws As Worksheet done = False Windows("Cancer monitoring (Commissioner).xls").Activate For Each ws In ActiveWorkbook.Worksheets If Left(ws.Name, 4) = Left(wbdatafile.Name, 4) Then wbdatafile.Open Range("A2").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy ThisWorkbook.Activate strWSName = wbdatafile.Name If SheetExists = True Then Worksheets(strWSName).Activate Range("B65536").End(xlUp).Offset(1, -1).Select ActiveSheet.Paste Range("B65536").End(xlUp).Offset(1, -1).Select wbdatafile.Activate ActiveWorkbook.Close done = True Exit For End If End If Next 'Rehide all worksheets Sheets("6.1 ReportDownload").Visible = False Sheets("6.2 ReportDownload").Visible = False Sheets("7.1 ReportDownload").Visible = False Sheets("7.2 ReportDownload").Visible = False Sheets("7.7 ReportDownload").Visible = False Sheets("7.8 ReportDownload").Visible = False Sheets("8.1 ReportDownload").Visible = False Sheets("8.2 ReportDownload").Visible = False Sheets("8.7 ReportDownload").Visible = False Sheets("9.1 ReportDownload").Visible = False Sheets("9.2 ReportDownload").Visible = False Sheets("10.1 ReportDownload").Visible = False Sheets("10.2 ReportDownload").Visible = False 'Switch on auto calculation With Application .Calculation = xlAutomatic .MaxChange = 0.001 End With ActiveWorkbook.PrecisionAsDisplayed = False 'Switch on screen flashing Application.ScreenUpdating = True End Sub 'More BT declarations Function GetDirectory(Optional Msg) As String Dim bInfo As BROWSEINFO Dim path As String Dim r As Long, x As Long, pos As Integer ' Root folder = Desktop bInfo.pidlRoot = 0& ' Title in the dialog If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." Else bInfo.lpszTitle = Msg End If ' Type of directory to return bInfo.ulFlags = &H1 ' Display the dialog x = SHBrowseForFolder(bInfo) ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetDirectory = Left(path, pos - 1) Else GetDirectory = "" End If End Function "sali" wrote: "BoRed79" je napisao u poruci interesnoj ... the problem - however - I am not really sure where to start in modifying my if it helps, try posting here the whole code, like copy/paste . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Help me to first row matching First date and last row matching lastrow | Excel Programming | |||
Matching identical data using data only once in the matching proce | Excel Discussion (Misc queries) | |||
Help with Matching Text Fields - Then Moving the Matching Cells Side by Side | Excel Discussion (Misc queries) | |||
Matching rows in 2 sheets and copying matching rows from sheet 1 t | Excel Programming | |||
Matching data and linking it to the matching cell | Links and Linking in Excel |