Trim the code

Anna Mary · Jul 12th 2021

Good Day,

Require assistance in trimming the below code + borders to be included for the range that consist text.

Code

Sub Update_Data()

Dim iRange As Range
Dim iCells As Range



Application.ScreenUpdating = False
    Sheets("Input").Select
    Range("B3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
        Sheets("Input").Select
    Range("C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
       Sheets("Input").Select
    Range("D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("J4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
      Sheets("Input").Select
    Range("E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("K4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
      Sheets("Input").Select
    Range("F3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("L4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
       Sheets("Input").Select
    Range("N3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("G4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
      Sheets("Input").Select
    Range("O3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("F4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
       Sheets("Input").Select
    Range("H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("M4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
       Sheets("Input").Select
    Range("I3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Output").Select
    Range("N4").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    
    Set iRange = ThisWorkbook.ActiveSheet.UsedRange
    
    For Each iCells In iRange
    If Not IsEmpty(iCells) Then
    iCells.BorderAround _
            LineStyle:=xlContinuous, _
            Weight:=xlThin
    End If
Next iCells
    
End Sub

Display More

Please help to trim the code - Anna

**royUK** · Jul 12th 2021

You can start by removing all the Selects. Your code selects the Input and output sheets several times and it isn't necessary at all.

Why are you selecting columns separately? It's not necessary to select and they could be copied together.

Attach an example of your workboo.

Anna Mary · Jul 12th 2021

royUK Thanks for your reply. Because I require column order to be rearranged in specific order.

Input reports are stored in different formats. Before fetching the output ( Default template) I require the data to get delimit and rearrange the column order and update the output.

Attaching the test file shortly.

Anna Mary · Jul 12th 2021

Here you go.. royUK

**royUK** · Jul 12th 2021

Does the original data contain formulas?

**royUK** · Jul 12th 2021

Try this.

Code

Sub Update_Data()
    
    Dim iRange As Range, iCells As Range
    Dim lRw As Long
    Dim wsInput As Worksheet, wsOutPut As Worksheet
    
    
    Set wsInput = Sheets("Input")
    Set wsOutPut = Sheets("Output")
    
    Application.ScreenUpdating = False
    With wsInput
        lRw = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Range(.Cells(3, 2), .Cells(lRw, 2)).Copy
        wsOutPut.Range("B4").PasteSpecial Paste:=xlPasteValues
        .Range(.Cells(3, 3), .Cells(lRw, 3)).Copy
        wsOutPut.Range("d4").PasteSpecial Paste:=xlPasteValues
        .Range(.Cells(3, 4), .Cells(lRw, 4)).Copy
        wsOutPut.Range("j4").PasteSpecial Paste:=xlPasteValues
        .Range(.Cells(3, 5), .Cells(lRw, 5)).Copy
        wsOutPut.Range("k4").PasteSpecial Paste:=xlPasteValues
        .Range(.Cells(3, 6), .Cells(lRw, 6)).Copy
        wsOutPut.Range("l4").PasteSpecial Paste:=xlPasteValues
        .Range(.Cells(3, 14), .Cells(lRw, 14)).Copy
        wsOutPut.Range("g4").PasteSpecial Paste:=xlPasteValues
        .Range(.Cells(3, 15), .Cells(lRw, 15)).Copy
        wsOutPut.Range("f4").PasteSpecial Paste:=xlPasteValues
        .Range(.Cells(3, 8), .Cells(lRw, 8)).Copy
        wsOutPut.Range("m4").PasteSpecial Paste:=xlPasteValues
        .Range(.Cells(3, 9), .Cells(lRw, 9)).Copy
        wsOutPut.Range("n4").PasteSpecial Paste:=xlPasteValues
    End With
    
    With wsOutPut
        Set iRange = .Range("B3").CurrentRegion
    End With
    
    Set iRange = iRange.Offset(1, 0).Resize(iRange.Rows.Count - 1, _
    iRange.Columns.Count)
    
    With iRange
        With .Cells.Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 0
        End With
    End With
    
    
End Sub

Display More

If you aren't copying formulas then the code could be made shorter

Anna Mary · Jul 12th 2021

Thank you royUK. Yes, the input data contain formulas. Looks much better than before.

**royUK** · Jul 12th 2021

You could actually improve the workbook by formatting the destination sheet's data as a Table. Then you wouldn't need to set the borders up in the code.

Anna Mary · Jul 12th 2021

royUK Sure, I will do that.. Any inputs on rearranging the columns in customized order?

**royUK** · Jul 12th 2021

I thought that was what the code is doing.

Anna Mary · Jul 12th 2021

Yes, But its completely based on copy-paste codes which is not dynamic.

**royUK** · Jul 12th 2021

My code is dynamic. the lRw variable determines the last row of the data to copy from Input Sheet.

Anna Mary · Jul 12th 2021

Oh thats nice. If I interchange the column header, will the output get fetched accurately?

**royUK** · Jul 12th 2021

I'm not sure what you mean

Anna Mary · Jul 12th 2021

royUK

I receive 5-6 columns of data from a client.

Scenario 1

column_e, column_b, column_a, column_c,column_d

Reqd. Output

column_a,column_b,column_c,column_d,column_e

Scenario 2

column_a, column_c, column_e, column_d,column_b

Reqd. Output

column_a,column_b,column_c,column_d,column_e

Scenario 3

column_a, column_c, column_e, column_d,column_b,column_f

Reqd. Output

column_a,column_b,column_c,column_d,column_e

As you can see the reqd. output, column order is fixed (column_a,column_b,column_c,column_d,column_e),

But I get inputs in different column order. I'm looking for a code which can work dynamically. Irrespective of the input, the columns should get rearranged to a,b,c,d,e..

**royUK** · Jul 12th 2021

You need to get your clients to provide data in an acceptable format.

If they all use the same headings then you might be able to use AdvancedFilter, but making it dynamic would be complicated.

**royUK** · Jul 12th 2021

Actually, if you can provide your clients with a template for the data that would make the task much simpler.

Trim the code

Participate now!

Share

Tags

Users Viewing This Thread