I have vba-code written for me but as I'm not ver knowledgeable about programming in vba ( I can follow the logic and understand what the code is doing) I cannot program it myself.
1. how can I make sure that whatever the size of imported data in the original sheet, is set as tabel1
The code splits up the raw data of a worksheet into different workbooks and/or worksheets depending on the content of certain cells.
A new workbook has to be made (or added to) whenever a cell in column A has WB: in it (in the attached file there are WB:AWP en WB:BM so there should be a workbook with the naam AWP and one with the name BM.
Each of these workbooks will contain worksheets that have the name of a location found in column F connectionlocation. The goal is to split the lines in the original worksheet (Sheet2) so that the content of each line is put in the right workbook and the right locationworksheet depending on the connectionlocation in column F.
The vba code does work this way but whenever it has to add to an already existing worksheet/book there is an error. As far as I have been able to debug the code, it cannot overwrite an exisiting worksheet. As the vba code is quite condensed I could not myself find the right way to insert a sub that would copy the information already in a sheet , add the line that caused the error into the right sheet and continue.
Any help would be greatly appreciated. If this explanation is not clear enough, I will gladly clarify.
ps :this problem was also posted on excelforum.com under the same title
regards
STephaan
1. how can I make sure that whatever the size of imported data in the original sheet, is set as tabel1
The code splits up the raw data of a worksheet into different workbooks and/or worksheets depending on the content of certain cells.
A new workbook has to be made (or added to) whenever a cell in column A has WB: in it (in the attached file there are WB:AWP en WB:BM so there should be a workbook with the naam AWP and one with the name BM.
Each of these workbooks will contain worksheets that have the name of a location found in column F connectionlocation. The goal is to split the lines in the original worksheet (Sheet2) so that the content of each line is put in the right workbook and the right locationworksheet depending on the connectionlocation in column F.
The vba code does work this way but whenever it has to add to an already existing worksheet/book there is an error. As far as I have been able to debug the code, it cannot overwrite an exisiting worksheet. As the vba code is quite condensed I could not myself find the right way to insert a sub that would copy the information already in a sheet , add the line that caused the error into the right sheet and continue.
Any help would be greatly appreciated. If this explanation is not clear enough, I will gladly clarify.
ps :this problem was also posted on excelforum.com under the same title
regards
STephaan
Code:
[COLOR=#333333]Dim a, it, i%, i1%, arr, sSectie$, sWB$, sC10$, splits, ssupervisor$, slocation$, sLocNEW$, MyKeys, sh As Worksheet, sLocWbC10$, MyKeysF, WB As Workbook, splits2[/COLOR]
With CreateObject("scripting.dictionary") 'create dictionary a = Range("Table1") 'read range into array For i = 1 To UBound(a) 'go through each row of the array If InStr(1, a(i, 1), "Section:", 1) = 1 Then 'does 1rst element start with "Section:" ? sSectie = Mid(a(i, 1), 9) 'new section ElseIf InStr(1, a(i, 1), "WB:", 1) = 1 Then 'same for WB sWB = Mid(a(i, 1), 4) ElseIf InStr(1, a(i, 1), "C10", 1) = 1 Then 'same for C10-type sC10 = a(i, 1) ElseIf InStr(1, a(i, 1), "supervisor:", 1) = 1 Then 'same for supervisor splits = Split(a(i, 1)) If UBound(splits) >= 2 Then ssupervisor = splits(1) slocation = splits(UBound(splits)) End If ElseIf Len(a(i, 1)) Then ' there is something in 1rst element (person) sLocNEW = Trim(a(i, 6)) 'possible wrong location If sLocNEW = "" Then sLocNEW = "Dummy" 'if nog location present, call it dummy If sLocNEW <> slocation Then 'is it a wrong location sLocWbC10 = slocation & "|" & sWB & "|" & sC10 & "|" & sLocNEW 'make a key with location & WB & C10 & new location it = .Item(sLocWbC10) 'check wether ifo present for wrong location If VarType(it) = vbEmpty Then 'if not ReDim arr(1 To UBound(a, 2) + 5, 1 To 1) 'make an empty array to be used later it = arr 'array is now called it Else ReDim Preserve it(1 To UBound(it), 1 To UBound(it, 2) + 1) 'add 1 column to existing array for that wrong location End If it(1, UBound(it, 2)) = sSectie 'fill out several items in 1rst or last added column it(2, UBound(it, 2)) = sWB it(3, UBound(it, 2)) = sC10 it(4, UBound(it, 2)) = ssupervisor it(5, UBound(it, 2)) = slocation For i1 = 1 To UBound(a, 2): it(i1 + 5, UBound(it, 2)) = a(i, i1): Next .Item(sLocWbC10) = it 'write result back to dictionary End If End If Next Application.ScreenUpdating = False If .Count Then 'if there is something in the dictionary, it means certain locations were wrong arr = Array("section", "WB", "C10", "supervisor", "location", "Name", "nr", "Portfolio", "Flux", "form", "Connectionlocation", "Check", "number") ' header MyKeys = .keys 'read the wrong locations in the dictionary-keys Do While UBound(MyKeys) >= 0 'check all keys 1 by 1 Set WB = Workbooks.Add 'add new workbook splits = Split(MyKeys(0), "|") 'split 1rst key still in Mykeys when "|" character is found MyKeysF = Filter(MyKeys, splits(0) & "|" & splits(1) & "|", 1, 1) 'filter in mykeys all keys with same location and WB For i = 0 To UBound(MyKeysF) 'loop through all keys of same location and WB splits2 = Split(MyKeysF(i), "|") ' split the key at every "|" character Set sh = WB.Worksheets.Add ' add new worksheet If sh Is Nothing Then ActiveSheet.Name = sh.Name = splits2(UBound(splits2)) 'if needed adapt name worksheet sh.Name = splits2(UBound(splits2)) 'rename worksheet to last term in in key(i.e. the wrong location) On Error Resume Next 'continue on error sh.Name = Left(splits2(UBound(splits2)), 31) 'rename worksheet to last term in in key(i.e. the wrong location) On Error GoTo 0 it = .Item(MyKeysF(i)) 'get respective array from dictionary sh.Range("A2").Resize(UBound(it, 2), UBound(it)).Value = WorksheetFunction.Transpose(it) 'write array in transposed option sh.Columns("G").NumberFormat = "0" 'layout for column 6 With sh.Range("A1").Resize(, UBound(arr) + 1) 'header .Value = arr 'write .EntireColumn.AutoFit 'adapt column width End With Next MyKeys = Filter(MyKeys, splits(0) & "|" & splits(1) & "|", 0, 1) 'remove all keys of that location and WB from MyKeys Application.DisplayAlerts = False With WB 'is the new workbook just created .SaveAs ThisWorkbook.Path & "\Fouten_" & splits(0) & "WB" & splits(1) .Close False End With Application.DisplayAlerts = True Loop End If End With [FONT=Verdana]End Sub[/FONT][/code
+]
Attachments
Last edited: