I had come previously for help with a formula in This Post.
1.
The formula seemed to have been working at the time, however once I added to it and began testing it using multiple inputs, it stopped properly working. It would only convert, transpose, and format the first input, multiple times in the outputted area.
What the output is suppose to look like
What the output actually looks like.Codec Make/Model Codec Serial Number Codec Barcode Codec 20000 20Z00000 A01123451 Codec 30000 20454811 A01248575
2.Codec 20000 20Z00000 A01123451 Codec 20000 20Z00000 A01123451
Originally, the VBA script was to...
1. Take the inputs, each located in their own cell in the first worksheet
2. Convert them from their comma deliminated format
3. Transpose them into the second worksheet
4. Format them by deleting cells, moving infromation around etc.
5. Go on to the next input and repeat the process.
3.
Example Input Located in a Single Cell
--Codec-- Make/Model: ,CODEC 99999, S/N: ,30a11111, B/C: ,A02586451, P/G: 234SD IP: ,99.010.088.00, Alias: ,23423, Mac: ,22-22-11-22-11-BG, --Camera-- Make/Model:,Codiac 2000, S/N: ,AA355555, B/C: ,A0121495, PG: ,A0121554, Mac: ,66-62-12-A8-41-CC, Camera Position: ,Front Below Monitor, --Monitor-- Make/Model: ,Aquos Quatron +, S/N: ,12345678, B/C: ,A4789451, Model #: ,LC-80LE8692, PG: ,PG-8451-1-2, Dimensions: ,80", --Phone-- Number: ,1 (000) 0000-0000, MAC: ,N/A, --Microphone-- Make/Model: ,Cisco Speak Easy, S/N: ,A1215422, PG: ,21191-0-2, Mic Position: ,Back Center Ceiling , --PC-- S/N: ,SDSDWAF, B/C: ,A0125687, MTM: ,99999999, PG: ,N/A, Mac: ,99-19-11-34-12-ZB, H/W: ,Thinkcenter M51, S/W: ,Windows 7, --Ports-- PC Port: ,A99, VC Port: ,A100, --Other-- Surge Protector: ,No, Wireless Keyboard and Mouse: ,Yes, Updated IP Address Alias Location Computer Login Stickers: ,Yes, --Notes/Extra-- ,,
Current VBA Script
4.Sub TransposeArray() Dim rngDst As Range Dim cl As Range Dim X As Variant Dim Count As Integer Count = 2 ' Sets Row Count Set rngDst = Sheets("Database (output)").Range("B2") 'Sets starting point for outputting the array For Each cl In Sheets("Input").Range("A1").Resize(Sheets("Input").Range("A" & Rows.Count).End(xlUp).Row) Count = Count + 1 ' Counts Which Row you are on X = Split(Range("A1").Value, ",") 'Splits Text, which is in a Comma deliminated format, into an array rngDst.Range("B2").Resize(, UBound(X) + 1).Value = X 'Resizes and inserts the array Sheets("Database (output)").Range("A" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("B" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("C" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("D" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("E" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("F" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("G" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("H" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("I" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("J" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("K" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("L" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("M" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("N" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("O" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("P" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("Q" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("R" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("S" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("T" & Count) = "Cisco IP Phone 7900 Series" 'Replaces text in Column T with "Cisco IP Phone 7900 Series" Sheets("Database (output)").Range("V" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("W" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("X" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("Y" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("Z" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AL" & Count).Copy Destination:=Worksheets("Database (output)").Range("AA" & Count) ' Copy computer make/model from AL column and pase into AA column Sheets("Database (output)").Range("AC" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AD" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AE" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AF" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AG" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AG" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AG" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AH" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AI" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AJ" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AK" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AL" & Count).Delete shift:=xlToLeft ' Deletes Sheets("Database (output)").Range("AM" & Count).Delete shift:=xlToLeft ' Deletes Set rngDst = rngDst.Offset(1) Next cl Sheets("Database (output)").Cells.WrapText = False 'Removes Word Wrap End Sub
Additionally I have attached a copy of the excel sheet to this post.
Attachment 342729
I appreciate any and all help. Thank you!
Bookmarks