• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

cell merge then row loop for undefined number of rows.

Alexdigin

New Member
Hi,

I am downloading order information from my webstore as a .csv then using a macro to reformat it by sending it to another workbook which I then use to upload the orders to my delivery software. I have to do this to make the field headings correct for the upload.

The address fields in G2:M2 need to be merged so that the address is in one field or I only upload the first line.

I can get the address cells to merge, but only the first row. But am struggling to get the right code to make the cell merge function loop through all of the rows, can someone please help? I will have a different number of rows each week so would need the code to be .lastRow, or .xlEnd I believe etc.

Here's my code, it may be basic but it works, I just need a loop to make the macro look at how many rows there are, merge cells G:M for each row and then send the information to my upload page.

Many thanks for the help.

Code:
Sub vegBoxOrderExport()
'
' vegBoxOrderExport Macro
'
  
  Range("G2:N2").Select
  Dim outputText As String
  Const delim = " "                                           This bit selects address fields and merge
  On Error Resume Next                                    (this could be chandoo code. if it is
  For Each cell In Selection                                      thanks)
  outputText = outputText & cell.Value & delim
  Next cell
  With Selection
  .Clear
  .Cells(1).Value = outputText
  .Merge
  .HorizontalAlignment = xlGeneral
  .VerticalAlignment = xlCenter
  .WrapText = True
  End With
   
    
  Range("A2:P2").Select
  Selection.Copy                                                          This bit selects the whole data
  Application.CutCopyMode = False                              page and sends it to uploadsheet
  Range("A2:P49").Select
  Selection.Copy
  Windows("ORDERUPLOAD.xlsx").Activate
  Range("A2").Select
  ActiveSheet.Paste
   
End Sub
 

Attachments

  • addressMerge.jpg
    addressMerge.jpg
    69.2 KB · Views: 8
Last edited by a moderator:
I think I understood. See if this helps.
Code:
Sub vegBoxOrderExport()
'
' vegBoxOrderExport Macro
'
Dim lastRow As Long
Dim outputText As String
Dim i As Long
Dim myRange As Range

Application.ScreenUpdating = False
'Where is last row of data?
lastRow = Cells(Rows.Count, "G").End(xlUp).Row
'Loop through all the rows
For i = 2 To lastRow
    Set myRange = Range(Cells(i, "G"), Cells(i, "N"))
    outputText = ConCat(" ", myRange)
    With myRange
        .Clear
        .Cells(1).Value = outputText
        .Merge
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
Next i

'Copy all of the data to other workbook. I wasn't sure which worksheet, so
'I just said to paste to the first sheet in the workbook
Range("A2:P" & lastRow).Copy Workbooks("ORDERUPLOAD.xlsx").Worksheets(1).Range("a2")
Application.ScreenUpdating = True
End Sub

Function ConCat(Delimiter As Variant, ParamArray CellRanges() As Variant) As String
'A handy function that I use in my Personal.xls workbook
    Dim cell As Range, Area As Variant

    If IsMissing(Delimiter) Then Delimiter = ""

    For Each Area In CellRanges
        If TypeName(Area) = "Range" Then
            For Each cell In Area
                If Len(cell.Value) Then ConCat = ConCat & Delimiter & cell.Value
            Next
        Else
            ConCat = ConCat & Delimiter & Area
        End If
    Next

    ConCat = Mid(ConCat, Len(Delimiter) + 1)
End Function
 
Luke, that's great thanks, it works like a charm.

For me it was two day's reading the web and trying code, a trip into town to get a book and all of no use. I am going to try something else and try to create a label printout from some of the information but i'll leave it a couple of day's so I don't go crackers.

Thanks again, it's just the job.
 
Back
Top