Need Help Streamlining Code

zendog1960

zendog1960

Active Member
Joined
Sep 27, 2003
Messages
459
Office Version
  1. 2019
Platform
  1. Windows
The following code does what I want for two rows but I have ten rows of data so I would like to streamline this down to one block of code that can do this work for all ten lines.

Any help would be appreciated!

<code>
Sub Copyinfo1()
Dim BottleDate As String
BottleDate = Range("AB5").Value

If BottleDate <> "" Then

'Select, copy, and paste Wine Name
Range("AD5").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Wines in Production").Select
Application.CutCopyMode = False

'Select, copy, and paste Wine Bottled Date
Sheets("Wines in Production").Select
Range("AB5").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Select, copy, and paste # of Bottles Made
Sheets("Wines in Production").Select
Range("Z5").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Select, copy, and paste Alcohol by Volume
Sheets("Wines in Production").Select
Range("Y5").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Wines in Production").Select
Range("AB2").Select

End If

End Sub

Sub Copyinfo2()
Dim BottleDate As String
BottleDate = Range("AB7").Value

If BottleDate <> "" Then

'Select, copy, and paste Wine Name
Range("AD7").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Wines in Production").Select
Application.CutCopyMode = False

'Select, copy, and paste Wine Bottled Date
Range("AB7").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Select, copy, and paste # of Bottles Made
Sheets("Wines in Production").Select
Range("Z7").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Select, copy, and paste Alcohol by Volume
Sheets("Wines in Production").Select
Range("Y7").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Wines in Production").Select
Range("AB2").Select

End If

End Sub
</code>
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Here is a example of how to shorten your code.

I took all this code:

Code: 
Range("AD5").Select
Selection.Copy
 Sheets("Finished Wines").Select
 Range("B5").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False

And shortened it to this:
Code: 
Range("AD5").Copy Destination:=Sheets("Finished Wines").Range("B5")
 
Upvote 0
Code: 
Sub myInputs()
     shtMain = "Wines in Production"
     shtFinishedWines = "Finished Wines"
     BottleDate = Sheets(shtMain).Range("AB5").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, 5)
     BottleDate = Sheets(shtMain).Range("AB7").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, 6)
End Sub
Sub myMacro(shtMain, shtFinishedWines, BottleDate, outputRow)
     If BottleDate <> "" Then
Sheets(shtFinishedWines).Range("B" & outputRow).Value = Sheets(shtMain).Range("AD" & outputRow).Value
          Sheets(shtFinishedWines).Range("C" & outputRow).Value = Sheets(shtMain).Range("AB" & outputRow).Value
          Sheets(shtFinishedWines).Range("D" & outputRow).Value = Sheets(shtMain).Range("Z" & outputRow).Value
          Sheets(shtFinishedWines).Range("E" & outputRow).Value = Sheets(shtMain).Range("Y" & outputRow).Value
     End If
End Sub
 
Upvote 0
WarPigl3t said:
Code: 
Sub myInputs()
     shtMain = "Wines in Production"
     shtFinishedWines = "Finished Wines"
     BottleDate = Sheets(shtMain).Range("AB5").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, 5)
     BottleDate = Sheets(shtMain).Range("AB7").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, 6)
End Sub
Sub myMacro(shtMain, shtFinishedWines, BottleDate, outputRow)
     If BottleDate <> "" Then
Sheets(shtFinishedWines).Range("B" & outputRow).Value = Sheets(shtMain).Range("AD" & outputRow).Value
          Sheets(shtFinishedWines).Range("C" & outputRow).Value = Sheets(shtMain).Range("AB" & outputRow).Value
          Sheets(shtFinishedWines).Range("D" & outputRow).Value = Sheets(shtMain).Range("Z" & outputRow).Value
          Sheets(shtFinishedWines).Range("E" & outputRow).Value = Sheets(shtMain).Range("Y" & outputRow).Value
     End If
End Sub
Click to expand...

This code seems to work but on the finished wines page only the first line is filled out while the next row down shows nothing. You may not have noticed but the Wines in Production page is every other row while the Finished Wines are listed row after row. maybe have an inputrow & outputrow variables?

Is there a way to accommodate this format structure or does the Wines in Production sheet need to be adjusted. The client prefers the extra row in-between each line for clarity but I might be able convince them in another direction if the current formatting isn't viable.

I like the streamlined code though! :)
 
Last edited:
Upvote 0
Code: 
Sub myInputs()
     shtMain = "Wines in Production"
     shtFinishedWines = "Finished Wines"
     BottleDate = Sheets(shtMain).Range("AB5").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, 5, 5)
     BottleDate = Sheets(shtMain).Range("AB7").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, 7, 6)
End Sub
Sub myMacro(shtMain, shtFinishedWines, BottleDate, inputRow, outputRow)
     If BottleDate <> "" Then
          Sheets(shtFinishedWines).Range("B" & outputRow).Value = Sheets(shtMain).Range("AD" & inputRow).Value
          Sheets(shtFinishedWines).Range("C" & outputRow).Value = Sheets(shtMain).Range("AB" & inputRow).Value
          Sheets(shtFinishedWines).Range("D" & outputRow).Value = Sheets(shtMain).Range("Z" & inputRow).Value
          Sheets(shtFinishedWines).Range("E" & outputRow).Value = Sheets(shtMain).Range("Y" & inputRow).Value
     End If
End Sub
 
Last edited:
Upvote 0
Code: 
Sub myInputs()
     shtMain = "Wines in Production"
     shtFinishedWines = "Finished Wines"
     BottleDate = Sheets(shtMain).Range("AB5").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, 5, 5)
     BottleDate = Sheets(shtMain).Range("AB7").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, 7, 6)
End Sub
Sub myMacro(shtMain, shtFinishedWines, BottleDate, inputRow, outputRow)
     If BottleDate <> "" Then
Sheets(shtFinishedWines).Range("B" & outputRow).Value = Sheets(shtMain).Range("AD" & inputRow).Value
          Sheets(shtFinishedWines).Range("C" & outputRow).Value = Sheets(shtMain).Range("AB" & inputRow).Value
          Sheets(shtFinishedWines).Range("D" & outputRow).Value = Sheets(shtMain).Range("Z" & inputRow).Value
          Sheets(shtFinishedWines).Range("E" & outputRow).Value = Sheets(shtMain).Range("Y" & inputRow).Value
     End If
End Sub

This worked. Now phase two and the more mind numbing process I can't even think on how to tackle. I would like the code above to additionally to do the following in this order:

1. Copy information from the Wines in Production sheet to the Finished Wines sheet which it already does
a. The change would be the as the list on the finished wines sheet grows, the copied info from the production sheet is added to the bottom of the list.
b. once that information as been transfered, the following cells on the production page are cleared, C, E, G, I, K, M, O, Q, S, T, U, V, W, Z, AA,
AB, AC. Being that there could be 10 different wines in production at any time, only those rows with a bottled date (AB Column) would be cleared and added to the
finished wines list on the Finished Wines sheet.

I hope that makes sense. I can provide a copy of the workbook if that would help.
 
Upvote 0
Ok, so I have revamped the code to make the copied info move to the finished wines page at the first empty row within the list. Now to figure out how to clear the cells I want cleared.

Here is the Code So far:

Code: 
Sub myInputs()
     shtMain = "Wines in Production"
     shtFinishedWines = "Finished Wines"
     
     Sheets("Finished Wines").Select
     Dim NextRow2 As Long
     Dim NextRow1 As Long
     NextRow1 = 5
     NextRow2 = Range("B" & Rows.Count).End(xlUp).Row + 1
     Range("G3").Value = NextRow2
     
     BottleDate = Sheets(shtMain).Range("AB5").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB7").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB9").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB11").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB13").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB15").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB17").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB19").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB21").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)
     
     NextRow2 = NextRow2 + 1
     NextRow1 = NextRow1 + 2
     BottleDate = Sheets(shtMain).Range("AB23").Value
     Call myMacro(shtMain, shtFinishedWines, BottleDate, NextRow1, NextRow2)

End Sub

Sub myMacro(shtMain, shtFinishedWines, BottleDate, inputRow, outputRow)
     If BottleDate <> "" Then
Sheets(shtFinishedWines).Range("B" & outputRow).Value = Sheets(shtMain).Range("AD" & inputRow).Value
          Sheets(shtFinishedWines).Range("C" & outputRow).Value = Sheets(shtMain).Range("AB" & inputRow).Value
          Sheets(shtFinishedWines).Range("D" & outputRow).Value = Sheets(shtMain).Range("Z" & inputRow).Value
          Sheets(shtFinishedWines).Range("E" & outputRow).Value = Sheets(shtMain).Range("Y" & inputRow).Value
     End If
End Sub
 
Last edited:
Upvote 0
I just wanted to say thank all that have helped with this today. It's been really helpful and educational!
 
Upvote 0
If I knew what your attempting to do in post #7 I think I could make that run better but I'm not sure what your attempting to do.
Be specific.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
207
Possum17
P
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
185
pennbowl
P
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
320
Azamamir
A
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
185
shknbk2
S
P
  • Question
Help with Vba Code
Replies
3
Views
176
Coyotex3
C

Forum statistics

Threads
1,215,372
Messages
6,124,535
Members
449,169
Latest member
mm424

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top