Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Long VBA Code - Can it be reduced
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
Nm Nm is offline
external usenet poster
  
Posts: 9
Default 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

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 125
Default 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


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
Nm Nm is offline
external usenet poster
  
Posts: 9
Default 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

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 220
Default 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

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
Nm Nm is offline
external usenet poster
  
Posts: 9
Default 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

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 125
Default 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


Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
Nm Nm is offline
external usenet poster
  
Posts: 9
Default 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

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
http://CannotDeleteFile.net - Cannot Delete File? Try Long Path ToolFilename is too long? Computer Complaining Your Filename Is Too Long? TheLong Path Tool Can Help While most people can go about their businessblissfully unaware of the Windo Max Loger Excel Discussion (Misc queries) 0 June 14th 11 04:30 PM
Code takes to long Oggy Excel Discussion (Misc queries) 1 March 30th 08 10:56 PM
Long Code Alam Excel Discussion (Misc queries) 2 November 15th 07 08:46 AM
my code too long? Zach Excel Worksheet Functions 2 August 3rd 05 07:53 PM
Long-winded code Hotbird Excel Programming 2 October 3rd 03 11:34 PM


All times are GMT +1. The time now is 12:57 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement