1
\$\begingroup\$

The below code is working uses formula to concatenate the result from Range("K:M") and write the result in column H.

Is there a better way to write the below code that can concatenate the result to the exact location as per below table? Please note that data in the before table is discontinued but sometimes will be from row 4 to 1000 rows down or the below example.

Sub GenerateStyleFabricColourV4()
    Dim srcData As Range
    Dim rowNum As Long, lastRow As Long

    With Worksheets(2)
        lastRow = Application.Max(4, _
                    .Cells(.Rows.Count, "K").End(xlUp).Row, _
                    .Cells(.Rows.Count, "L").End(xlUp).Row, _
                    .Cells(.Rows.Count, "M").End(xlUp).Row)
        With .Cells(4, "H").Resize(lastRow - 4 + 1, 1)
            .FormulaR1C1 = "=rc[3]&rc[4]&rc[5]"
            .Value = .Value2
        End With
    End With
End Sub


Sub ClearAllData()

Rows("4:" & Rows.Count).ClearContents

End Sub
\$\endgroup\$
  • \$\begingroup\$ I suppose it works for you, but it's very difficult for us to review it without knowing your data. (e.g. depending on your data table, you may use range.currentregion instead of the multiple end(xlup) calls. \$\endgroup\$ – Máté Juhász Apr 10 '17 at 11:20
  • \$\begingroup\$ @MátéJuhász Will post the data as soon as i get home sorry about that. \$\endgroup\$ – QuickSilver Apr 10 '17 at 11:32
  • 1
    \$\begingroup\$ Would you clearly say what's your question? \$\endgroup\$ – M-- Apr 10 '17 at 14:44
  • \$\begingroup\$ @MátéJuhász Just updated the data table. \$\endgroup\$ – QuickSilver Apr 10 '17 at 18:42
  • \$\begingroup\$ @QuickSilver If my answer resolve the problem for you please consider reviewing it and marking as accepted to help the other users find their answers later on. \$\endgroup\$ – M-- Apr 10 '17 at 20:44
3
\$\begingroup\$

Update

To answer another question I provided some helpful information about optimization in vba. You can reach to that from this Link

Original Answer To This Question

This maybe help you to skip the blank rows (You did not clarify your question but based on the data you provided I think that would be your problem) and find the actual last row used. It is in reference to this post. Here's the code:

Dim srcData As Range, rng As Range
Dim rowNum As Long, lastRow As Long
Dim wsh As Worksheet

Sub GSFC_V4()
 Set wsh = Worksheets(2)

 wsh.Activate
 Set srcData = Range("K:M")
 Set rng = Range("K4")


 With wsh 
  If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
     lastrow = srcData.Find(What:="*", _
                  After:=rng, _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Row
 Else
     lastrow = 1  
 End If


     With .Cells(4, "H").Resize(lastRow - 4 + 1, 1)
         .FormulaR1C1 = "=rc[3]&rc[4]&rc[5]"
         .Value = .Value2
     End With
 End With

End Sub

This is the code I am using to optimize my macros. I call OptimizeVBA True at the beginning of each macro and at the end call OptimizeVBA False to set everything back to default. This increases the performances my macros remarkably, when the time of computations is significant. (I got this exact format a while ago from a forum or a webpage. Will refer to it if remembered from where exactly.)

Sub OptimizeVBA(isOn As Boolean)

  Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
  Application.EnableEvents = Not (isOn)
  Application.ScreenUpdating = Not (isOn)
  Application.StatusBar = Not (isOn)

End Sub

You need to be careful how you refer to ranges to avoid from getting errors.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Gives a run time error 1000 on the ` With .Cells(4, "H").Resize(lastRow - 4 + 1, 1)` can't work out why. \$\endgroup\$ – QuickSilver Apr 14 '17 at 7:34
  • \$\begingroup\$ @QuickSilver This is not the optimized way to do it but you can try this: before that "With block" add this .Cells(4, "H").Select and substitute the .Cells(4,"H"). with Selection.. You may need to put the second with block out of the first one (i.e. With wsh). \$\endgroup\$ – M-- Apr 14 '17 at 13:19
1
\$\begingroup\$

I had an old script on hand that accomplished most of what I think you're after, though it uses a different approach. I modified it and it seems to work with your data. You'll need to update at least a couple values in the code — see comments.

Option Explicit

Sub GSFC_V4()

Application.ScreenUpdating = False

Dim wb As Workbook
Set wb = Workbooks("ConcatTest.xlsx") 'update workbook name

Dim ws As Worksheet
Set ws = wb.Sheets("Sheet1") 'update worksheet name

Dim TextS As String
Dim TextF As String
Dim TextC As String

Dim StartRow As Long
StartRow = 5 'assumes row 5 is the first row containing data to be concatenated
Dim LastRow As Long, lRow1 As Long, lRow2 As Long, lRow3 As Long
lRow1 = Range("K" & Rows.Count).End(xlUp).Row
lRow2 = Range("L" & Rows.Count).End(xlUp).Row
lRow3 = Range("M" & Rows.Count).End(xlUp).Row 
LastRow = WorksheetFunction.Max(lRow1, lRow2, lRow3)

Dim CheckCell As Range
Dim ConcatRange As Range
Set ConcatRange = Range(ws.Cells(StartRow, "K"), ws.Cells(LastRow, "K"))

Dim i As Long
i = StartRow

For Each CheckCell In ConcatRange
  TextS = ws.Cells(i, "K").Value
  TextF = ws.Cells(i, "L").Value
  TextC = ws.Cells(i, "M").Value
  i = i + 1
  If Not CheckCell.Value = "" Then
    CheckCell.Offset(0, -3).Value = TextS & TextF & TextC
  End If
Next CheckCell

Application.ScreenUpdating = True

End Sub
| improve this answer | |
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.