Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How do I simplify this VBA switch statement to not repeat so much code?

I am writing an Excel macro that copies information from 1 worksheet and pastes it to another. It has to search for a specific string of text to identify the right column to copy, and I'm using a switch statement to go through the various columns. It's going all the way to Z, so it's very long macro. I also need to use this for several search terms, which makes the macro too large.

Here is an excerpt of the code:

Select Case True
  Case Range("A1").Value = "SearchTerm1"
    Sheets("ExportSheet").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Template").Select
    Range("L2").Select
    ActiveSheet.Paste
  Case Range("B1").Value = "SearchTerm1"
    Sheets("ExportSheet").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Template").Select
    Range("L2").Select
    ActiveSheet.Paste
  Case Range("C1").Value = "SearchTerm1"
    Sheets("ExportSheet").Select
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Template").Select
    Range("L2").Select
    ActiveSheet.Paste
  Case Range("D1").Value = "SearchTerm1"
    Sheets("ExportSheet").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Template").Select
    Range("L2").Select
    ActiveSheet.Paste
  Case Range("E1").Value = "SearchTerm1"
    Sheets("ExportSheet").Select
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Template").Select
    Range("L2").Select
    ActiveSheet.Paste

It's going through the columns 1 by 1 to see if it contains a specific search term. If it does, it copies everything underneath it and pastes it starting in cell L2 on a separate worksheet. It's just a very long macro and I'm trying to simplify it. Would a For loop work?

like image 719
Alex Klinghoffer Avatar asked May 16 '26 17:05

Alex Klinghoffer


2 Answers

  1. Your variant has been updated if you prefer this method

With Sheets("ExportSheet")
Select Case True
    Case .[A1].Value = "SearchTerm1"
        .Range("A2:A" & Cells(.Rows.Count, "A").End(xlUp).Row).Copy Sheets("Template").[L2]
    Case .[B1].Value = "SearchTerm1"
        .Range("B2:B" & Cells(.Rows.Count, "B").End(xlUp).Row).Copy Sheets("Template").[L2]
    Case .[C1].Value = "SearchTerm1"
        .Range("C2:C" & Cells(.Rows.Count, "C").End(xlUp).Row).Copy Sheets("Template").[L2]
    ' and so on
End Select
End With

End Sub
  1. Optimal variant imho is Find method

Sub test2()
Dim x&, y&
On Error GoTo errorhandler
    With Sheets("ExportSheet")
        y = .Rows(1).Find("SearchTerm1").Column
        x = .Cells(Rows.Count, y).End(xlUp).Row
        .Range(.Cells(2, y), .Cells(x, y)).Copy Sheets("Template").[L2]
    End With
Exit Sub
errorhandler:
    MsgBox "There is no 'SearchTerm1' in 'ExportSheet'!"
End Sub
  1. For each looping through the range of cells also optimal I think

Sub test3()
Dim Cl As Range
For Each Cl In Sheets("ExportSheet").[A1:E1]
    If Cl.Value = "SearchTerm1" Then
        Sheets("ExportSheet").Range(Cl.Offset(1, 0).Address(0, 0), _
            Cells(Rows.Count, Cl.Column).End(xlUp).Address(0, 0)).Copy _
        Sheets("Template").[L2]
        Exit For
    End If
Next
End Sub
like image 177
Vasily Ivoyzha Avatar answered May 18 '26 16:05

Vasily Ivoyzha


As I understand it, you are actually looking for the header from which you need to copy the data. If that is so:

With Sheets("ExportSheet")
    Dim r As Range: Set r = .Range("1:1").Find("SearchTerm1")
    If Not r Is Nothing Then 
        .Range(r.Offset(1, 0), r.Offset(1, 0).End(xlDown)).Copy _
            Sheets("Template").Range("L2")
    End If
End With
like image 36
L42 Avatar answered May 18 '26 17:05

L42