steelstorm
04-18-2013, 10:39 AM
Hi Everyone,
I was able to piece together a semi working macro to format spreadsheets a specific way so I can bulk upload them with another tool at our office instead of entering them in manually.
Now the problem I'm having is the loop. I have the code working fine.....but only for one order. I just cannot getting it working properly to go through the rest of the orders.
The first two Sub's (ColumnUngluing & JoinAndMerge) will need to loop down the rest of the sheet and stop when there are no more orders.
The 3rd Sub in the code (Rename) only has two parts that need to loop because the rest of the sub is just re-naming column headers.
The 2 parts that need looped are Range A2 & B2. These numbers need to be inserted down the column to fill in and stop when there are no more orders.
Below is the existing code I have been able to piece together so far. I will also attach a copy of an example worksheet.
Any help would be greatly appreciated.
Sub OpusOrderUpload()
Columns("J:K").Select
Selection.Insert Shift:=xlToRight
Range("I2").Select
Call ColumnUngluing
Range("P1:W1").Cells.ClearContents
Columns("B:C").Delete
Columns("E:F").Delete
Columns("K:K").Delete
Call JoinAndMerge
Columns("A:B").Select
Selection.Insert Shift:=xlToRight
Call Rename
End Sub
Sub ColumnUngluing()
'
' ColumnDataUngluing Macro
' takes data in one cell and splits it by spaces. then moves the data to separate columns
Selection.TextToColumns Destination:=Range("I2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(13, 1)), TrailingMinusNumbers:= _
True
End Sub
Sub JoinAndMerge()
Range("K2:R2").Select
Dim outputText As String
delim = " "
On Error Resume Next
For Each cell In Selection
outputText = outputText & cell.Value & delim
Next cell
With Selection
.Clear
.Cells(1).Value = outputText
.Merge
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
End With
End Sub
Sub Rename()
Range("A1").Value = "Client ID"
Range("A2").Value = "1035"
Range("B1").Value = "Product"
Range("B2").Value = "1419"
Range("G1").Value = "STREET #"
Range("H1").Value = "STREET NAME"
Range("I1").Value = "STREET TYPE"
Range("M1").Value = "INSTRUCTIONS"
End Sub
I was able to piece together a semi working macro to format spreadsheets a specific way so I can bulk upload them with another tool at our office instead of entering them in manually.
Now the problem I'm having is the loop. I have the code working fine.....but only for one order. I just cannot getting it working properly to go through the rest of the orders.
The first two Sub's (ColumnUngluing & JoinAndMerge) will need to loop down the rest of the sheet and stop when there are no more orders.
The 3rd Sub in the code (Rename) only has two parts that need to loop because the rest of the sub is just re-naming column headers.
The 2 parts that need looped are Range A2 & B2. These numbers need to be inserted down the column to fill in and stop when there are no more orders.
Below is the existing code I have been able to piece together so far. I will also attach a copy of an example worksheet.
Any help would be greatly appreciated.
Sub OpusOrderUpload()
Columns("J:K").Select
Selection.Insert Shift:=xlToRight
Range("I2").Select
Call ColumnUngluing
Range("P1:W1").Cells.ClearContents
Columns("B:C").Delete
Columns("E:F").Delete
Columns("K:K").Delete
Call JoinAndMerge
Columns("A:B").Select
Selection.Insert Shift:=xlToRight
Call Rename
End Sub
Sub ColumnUngluing()
'
' ColumnDataUngluing Macro
' takes data in one cell and splits it by spaces. then moves the data to separate columns
Selection.TextToColumns Destination:=Range("I2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(13, 1)), TrailingMinusNumbers:= _
True
End Sub
Sub JoinAndMerge()
Range("K2:R2").Select
Dim outputText As String
delim = " "
On Error Resume Next
For Each cell In Selection
outputText = outputText & cell.Value & delim
Next cell
With Selection
.Clear
.Cells(1).Value = outputText
.Merge
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
End With
End Sub
Sub Rename()
Range("A1").Value = "Client ID"
Range("A2").Value = "1035"
Range("B1").Value = "Product"
Range("B2").Value = "1419"
Range("G1").Value = "STREET #"
Range("H1").Value = "STREET NAME"
Range("I1").Value = "STREET TYPE"
Range("M1").Value = "INSTRUCTIONS"
End Sub