|
Long VBA Code - Can it be reduced
Hi
I have created the following VBA code, all it does is to check if data is present in a column (either A, B, C) and then copy it in a separate sheet in the same file. I am sure there must be a way to do it so that code is shorter than what I have. Please make suggestions as I cant comeup with anything right now. Thanks, Naeem ------------------------------------------------- If Sheet1.Range("A1") = "YES" Then Range("Data_1").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_1") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("B1") = "YES" Then Range("Data_2").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_2") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select Else If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If End If Else If Sheet1.Range("B1") = "YES" Then Range("Data_2").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_2") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If Else If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If End If End If End If End Sub |
Long VBA Code - Can it be reduced
Have you thought of using an array ?
"Nm" wrote: Hi I have created the following VBA code, all it does is to check if data is present in a column (either A, B, C) and then copy it in a separate sheet in the same file. I am sure there must be a way to do it so that code is shorter than what I have. Please make suggestions as I cant comeup with anything right now. Thanks, Naeem ------------------------------------------------- If Sheet1.Range("A1") = "YES" Then Range("Data_1").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_1") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("B1") = "YES" Then Range("Data_2").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_2") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select Else If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If End If Else If Sheet1.Range("B1") = "YES" Then Range("Data_2").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_2") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If Else If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If End If End If End If End Sub |
Long VBA Code - Can it be reduced
On Jul 10, 3:38 pm, Dan Thompson
wrote: Have you thought of using an array ? "Nm" wrote: Hi I have created the following VBA code, all it does is to check if data is present in a column (either A, B, C) and then copy it in a separate sheet in the same file. I am sure there must be a way to do it so that code is shorter than what I have. Please make suggestions as I cant comeup with anything right now. Thanks, Naeem ------------------------------------------------- If Sheet1.Range("A1") = "YES" Then Range("Data_1").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_1") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("B1") = "YES" Then Range("Data_2").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_2") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select Else If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If End If Else If Sheet1.Range("B1") = "YES" Then Range("Data_2").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_2") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheet1.Select If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If Else If Sheet1.Range("C1") = "YES" Then Range("Data_3").Select Selection.Copy Sheets.Add ActiveSheet.Name = Range("Sheet_Name_3") Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Columns.AutoFit Sheets("Sheet1").Select Range("H5").Select End If End If End If End If End Sub- Hide quoted text - - Show quoted text - Hi, No - I have never used them. Naeem |
Long VBA Code - Can it be reduced
Naeem try this:
Sub Test() For Each Cell In ActiveSheet.Range("A1:C1") If Cell.Value = "YES" Then Select Case Mid(Cell.Address, 2, 1) Case Is = "A" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_1") Range("Data_1").Copy Sheets(Range( _ "Sheet_Name_1").Text).Range("A1") Sheets(Range("Sheet_Name_1").Text).Columns("A").Au toFit Case Is = "B" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_2") Range("Data_2").Copy Sheets(Range( _ "Sheet_Name_2").Text).Range("A1") Sheets(Range("Sheet_Name_2").Text).Columns("A").Au toFit Case Is = "C" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_3") Range("Data_3").Copy Sheets(Range( _ "Sheet_Name_3").Text).Range("A1") Sheets(Range("Sheet_Name_3").Text).Columns("A").Au toFit End Select End If Next Cell End Sub -- Dan |
Long VBA Code - Can it be reduced
On Jul 10, 3:57 pm, "Dan R." wrote:
Naeem try this: Sub Test() For Each Cell In ActiveSheet.Range("A1:C1") If Cell.Value = "YES" Then Select Case Mid(Cell.Address, 2, 1) Case Is = "A" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_1") Range("Data_1").Copy Sheets(Range( _ "Sheet_Name_1").Text).Range("A1") Sheets(Range("Sheet_Name_1").Text).Columns("A").Au toFit Case Is = "B" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_2") Range("Data_2").Copy Sheets(Range( _ "Sheet_Name_2").Text).Range("A1") Sheets(Range("Sheet_Name_2").Text).Columns("A").Au toFit Case Is = "C" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_3") Range("Data_3").Copy Sheets(Range( _ "Sheet_Name_3").Text).Range("A1") Sheets(Range("Sheet_Name_3").Text).Columns("A").Au toFit End Select End If Next Cell End Sub -- Dan Hi Dan, I tried and it works..Wow its way shorter than what I have. I will go through it and try to understand the code. Thank you. Naeem |
Long VBA Code - Can it be reduced
You can use this code it is much shorter very simple but you said you wanted
to shorten so this is the shortest way to do it. That I can think of. Sub CopyData() Dim MyRange As Range Dim cel As Range Set MyRange = Worksheets("Sheet1").Range("A1:C500") 'You can change the range to what ever you need it For Each cel In MyRange If Not cel.Value = "" Then xVal = cel.Value xaddress = cel.Address Worksheets("Sheet2").Range(xaddress).Value = xVal End If Next cel End Sub "Dan R." wrote: Naeem try this: Sub Test() For Each Cell In ActiveSheet.Range("A1:C1") If Cell.Value = "YES" Then Select Case Mid(Cell.Address, 2, 1) Case Is = "A" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_1") Range("Data_1").Copy Sheets(Range( _ "Sheet_Name_1").Text).Range("A1") Sheets(Range("Sheet_Name_1").Text).Columns("A").Au toFit Case Is = "B" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_2") Range("Data_2").Copy Sheets(Range( _ "Sheet_Name_2").Text).Range("A1") Sheets(Range("Sheet_Name_2").Text).Columns("A").Au toFit Case Is = "C" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_3") Range("Data_3").Copy Sheets(Range( _ "Sheet_Name_3").Text).Range("A1") Sheets(Range("Sheet_Name_3").Text).Columns("A").Au toFit End Select End If Next Cell End Sub -- Dan |
Long VBA Code - Can it be reduced
On Jul 10, 4:14 pm, Dan Thompson
wrote: You can use this code it is much shorter very simple but you said you wanted to shorten so this is the shortest way to do it. That I can think of. Sub CopyData() Dim MyRange As Range Dim cel As Range Set MyRange = Worksheets("Sheet1").Range("A1:C500") 'You can change the range to what ever you need it For Each cel In MyRange If Not cel.Value = "" Then xVal = cel.Value xaddress = cel.Address Worksheets("Sheet2").Range(xaddress).Value = xVal End If Next cel End Sub "Dan R." wrote: Naeem try this: Sub Test() For Each Cell In ActiveSheet.Range("A1:C1") If Cell.Value = "YES" Then Select Case Mid(Cell.Address, 2, 1) Case Is = "A" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_1") Range("Data_1").Copy Sheets(Range( _ "Sheet_Name_1").Text).Range("A1") Sheets(Range("Sheet_Name_1").Text).Columns("A").Au toFit Case Is = "B" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_2") Range("Data_2").Copy Sheets(Range( _ "Sheet_Name_2").Text).Range("A1") Sheets(Range("Sheet_Name_2").Text).Columns("A").Au toFit Case Is = "C" Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_3") Range("Data_3").Copy Sheets(Range( _ "Sheet_Name_3").Text).Range("A1") Sheets(Range("Sheet_Name_3").Text).Columns("A").Au toFit End Select End If Next Cell End Sub -- Dan- Hide quoted text - - Show quoted text - Hi Dan, I tried running this code and comeup with the following error. Run-time error '9': Subscript Out of Range and it highlights the following Worksheets("Sheet2").Range(xaddress).Value = xVal In my file I have only 1 sheet and when I run the macro it adds separate sheet for each data column and I am thinking may be thats why the error comes up as there is no Sheet 2. My other question is that in this coding I dont see coding for adding addtional worksheet, am I correct ? Naeem |
Long VBA Code - Can it be reduced
Here's a shorter way that works...
Sub Test() For Each cell In ActiveSheet.Range("A1:C1") If cell.Value = "YES" Then Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_" & cell.Column) Range("Data_" & cell.Column).Copy _ Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Range("A1") Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Columns("A").AutoFit End If Next cell End Sub -- Dan |
Long VBA Code - Can it be reduced
On Jul 10, 4:46 pm, "Dan R." wrote:
Here's a shorter way that works... Sub Test() For Each cell In ActiveSheet.Range("A1:C1") If cell.Value = "YES" Then Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_" & cell.Column) Range("Data_" & cell.Column).Copy _ Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Range("A1") Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Columns("A").AutoFit End If Next cell End Sub -- Dan Great - That works. Thank you. I will go through it as well and try to understand. Thanks again for all your help Naeem |
Long VBA Code - Can it be reduced
"Dan R." wrote: Here's a shorter way that works... Sub Test() For Each cell In ActiveSheet.Range("A1:C1") If cell.Value = "YES" Then Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_" & cell.Column) Range("Data_" & cell.Column).Copy _ Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Range("A1") Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Columns("A").AutoFit End If Next cell End Sub -- Dan Gee Thats funny that it works for NM cause when I run Dan R. Code I get a Run-Time Error "Method 'Range' of 'object '_Global' failed" Whats with ("Sheet_Name_ ect... ") and ("Data_" ...ect) are they user variables or are they actual vba commands ? |
Long VBA Code - Can it be reduced
On Jul 10, 6:00 pm, Dan Thompson
wrote: "Dan R." wrote: Here's a shorter way that works... Sub Test() For Each cell In ActiveSheet.Range("A1:C1") If cell.Value = "YES" Then Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_" & cell.Column) Range("Data_" & cell.Column).Copy _ Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Range("A1") Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Columns("A").AutoFit End If Next cell End Sub -- Dan Gee Thats funny that it works for NM cause when I run Dan R. Code I get a Run-Time Error "Method 'Range' of 'object '_Global' failed" Whats with ("Sheet_Name_ ect... ") and ("Data_" ...ect) are they user variables or are they actual vba commands ?- Hide quoted text - - Show quoted text - Hi Dan, The ("Sheet_Name_ ect... ") and ("Data_" ...ect) are ranges in my file. Naeem |
Long VBA Code - Can it be reduced
On Jul 11, 9:47 am, Nm wrote:
On Jul 10, 6:00 pm, Dan Thompson wrote: "Dan R." wrote: Here's a shorter way that works... Sub Test() For Each cell In ActiveSheet.Range("A1:C1") If cell.Value = "YES" Then Set sh = ThisWorkbook.Worksheets.Add sh.Name = Range("Sheet_Name_" & cell.Column) Range("Data_" & cell.Column).Copy _ Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Range("A1") Sheets(Range("Sheet_Name_" & _ cell.Column).Text).Columns("A").AutoFit End If Next cell End Sub -- Dan Gee Thats funny that it works for NM cause when I run Dan R. Code I get a Run-Time Error "Method 'Range' of 'object '_Global' failed" Whats with ("Sheet_Name_ ect... ") and ("Data_" ...ect) are they user variables or are they actual vba commands ?- Hide quoted text - - Show quoted text - Hi Dan, The ("Sheet_Name_ ect... ") and ("Data_" ...ect) are ranges in my file. Naeem- Hide quoted text - - Show quoted text - Hi Dan, The ("Sheet_Name_ ect... ") and ("Data_" ...ect) are ranges in my file. Naeem |
| All times are GMT +1. The time now is 12:28 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com