Understanding This Code

Question

I have pasted below some code that works wonderfully for me. However, every time I try to use it on another set of columns, I cannot get it to work right, so can anyone possibly check my comments, and then complete comments for all the other lines, so that when I reuse it, I can figure out how to alter it?

Sub CustomChoices()

Dim ws1 As Worksheet, ws2 As Worksheet

Dim rA As Long, rB As Long, r As Long, N As Long, i As Integer

'This tells us the name of the SOURCE worksheet

Set ws1 = Sheets("CustomChoiceSets")

'This tells us the name of the DESTINATION worksheet

Set ws2 = Sheets("ChoicesData")

Application.ScreenUpdating = False

'This tells us the FIRST cell in column A of the SOURCE worksheet

rA = ws1.Cells(Rows.Count, "A").End(xlUp).Row

'This tells us the LAST cell in column B of the SOURCE worksheet

rB = ws1.Cells(Rows.Count, "B").End(xlUp).Row

'This Counts the number of rows in column A of the DESTINATION worksheet

r = ws2.Cells(Rows.Count, "A").End(xlUp).Row

'This checks to see if A1 in the DESTINATION worksheet is empty. If not, start pasting in first blank row

If ws2.Range("A1") = "" Then N = 1 Else: N = r + 1

'....

For i = 2 To rA

ws1.Cells(i, 1).Copy

ws2.Cells(N, 1).Resize(rB - 1).PasteSpecial xlValues

ws1.Range("B2:B" & rB).Copy

ws2.Cells(N, 2).PasteSpecial xlValues

N = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

Next i

'Application.CutCopyMode = False

'Application.ScreenUpdating = True

End Sub

For instance, right now, I want to...on ONE worksheet called mapchoices, take the data from columns B and C and paste into H and I. But my currently altered code CUTS the data from column A (huh?) and pastes only . I took the code above and altered it to the code below. Of course, I've tried changing various values and can't get it to work, so if something I changed looks ridiculous, it's because I'm ridiculously desperate. LOL

Sub MapChoices()

Dim ws1 As Worksheet, ws2 As Worksheet

Dim rA As Long, rB As Long, r As Long, N As Long, i As Integer

Set ws1 = Sheets("MapChoices")

Set ws2 = Sheets("MapChoices")

'Application.ScreenUpdating = False

rA = ws1.Cells(Rows.Count, "C").End(xlUp).Row

rB = ws1.Cells(Rows.Count, "D").End(xlUp).Row

r = ws2.Cells(Rows.Count, "H").End(xlUp).Row

If ws2.Range("H2") = "" Then N = 1 Else: N = r + 1

For i = 2 To rA

ws1.Cells(i, 2).Copy

ws2.Cells(N, 1).Resize(rB - 1).PasteSpecial xlValues

ws1.Range("D2:D" & rB).Copy

ws2.Cells(N, 9).PasteSpecial xlValues

N = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

Next i

Application.CutCopyMode = False

'Application.ScreenUpdating = True

End Sub

Answer 1

Sub CustomChoices()

Dim ws1 As Worksheet, ws2 As Worksheet

Dim rA As Long, rB As Long, r As Long, N As Long, i As Integer

'This tells us the name of the SOURCE worksheet  >>>YES

Set ws1 = Sheets("CustomChoiceSets")

'This tells us the name of the DESTINATION worksheet >>>YES

Set ws2 = Sheets("ChoicesData") 

Application.ScreenUpdating = False

'This tells us the FIRST cell in column A of the SOURCE worksheet >>>NO, finds 'the last not empty cell (in column A),' e.g if in column A there is only one value in cell A12 (A1 - A11 are empty) ' then returns 12 If column A is empty returns 1

rA = ws1.Cells(Rows.Count, "A").End(xlUp).Row

'This tells us the LAST cell in column B of the SOURCE worksheet >>>>YES like rA

rB = ws1.Cells(Rows.Count, "B").End(xlUp).Row

'This Counts the number of rows in column A of the DESTINATION worksheet >>> YES like' rA and rB but on ws2 and in column A

r = ws2.Cells(Rows.Count, "A").End(xlUp).Row

'This checks to see if A1 in the DESTINATION worksheet is empty. If not, start pasting in first blank row >>> YES

If ws2.Range("A1") = "" Then N = 1 Else: N = r + 1

'....

For i = 2 To rA

ws1.Cells(i, 1).Copy

ws2.Cells(N, 1).Resize(rB - 1).PasteSpecial xlValues

ws1.Range("B2:B" & rB).Copy

ws2.Cells(N, 2).PasteSpecial xlValues

N = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

Next i

'Application.CutCopyMode = False

'Application.ScreenUpdating = True

End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

.... 'take data'

you mean: 'cut data'

from  columns B and C??

if so, try this

(first, make a copy...)

Sub MapChoices()

Dim ws1 As Worksheet

Dim rB As Long, rC As Long

Set ws1 = Sheets("MapChoices")

'Application.ScreenUpdating = False

rB = ws1.Cells(Rows.Count, "B").End(xlUp).Row

rC = ws1.Cells(Rows.Count, "C").End(xlUp).Row

ws1.Range("B1:B" & rB).Copy Destination:=ws1.Range("H1")

ws1.Range("B1:B" & rB).ClearContents

ws1.Range("C1:C" & rC).Copy Destination:=ws1.Range("I1")

ws1.Range("C1:C" & rC).ClearContents

'Application.ScreenUpdating = True

End Sub

Answer 2

Tasos: I have had a very rough day. Finally decided to take a break and work on this. It is beautiful. I cannot thank you enough for your time.

Answer 3

Yes, I forgot to say #2, but I know how to add that. :)

Thanks, TasosK. I'm home for Easter now, but will try it out tomorrow!

Answer 4

Hi Anne,

1. All combinations (in columns I and J) depend on data in columns D and E?
2. Each time you run the code (hit Add) previous combinations will be deleted?

if so, try this...

(make a copy before...)

Sub macro1()

Dim ws1 As Worksheet

Dim rD As Long, rE As Long, r As Long, N As Long, i As Integer

Set ws1 = Sheets("CreateChoiceSets")

Application.ScreenUpdating = False

rD = ws1.Cells(Rows.Count, "D").End(xlUp).Row

rE = ws1.Cells(Rows.Count, "E").End(xlUp).Row

r = ws1.Cells(Rows.Count, "I").End(xlUp).Row

ws1.Range("I2:J" & r).ClearContents

N = 2

For i = 2 To rD

ws1.Cells(i, "D").Copy

ws1.Cells(N, "I").Resize(rE - 1).PasteSpecial xlValues

ws1.Range("E2:E" & rE).Copy

ws1.Cells(N, "J").PasteSpecial xlValues

N = ws1.Cells(Rows.Count, "I").End(xlUp).Row + 1

Next i

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Answer 5

To Cimjet: I'm sorry. I don't understand your code either, and I got an error when I tried.

TasosK, is there any way you can help me with this new "version" of the same code?

I have uploaded a workbook with complete explanation. Basically the same task, but we don't cross worksheets. I cannot get our previous code to work. :(

I am completely aware that I owe you, Big Time. Is there anything I can do for you?

You can check the workbook here: http://www.annetroy.com/ms/SetMaker.xlsx

Thank you sooooo much!