need a macro explaining

P

project manager

is it possible for someone to annotate this macro so i can understand what
its doing and try to learn from it.

Option Explicit
Sub Summary()
Dim ws As Worksheet
Dim i As Long, j As Long, rw As Long

Set ws = Sheets("Summary")
For j = 1 To 7
rw = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 1 To 7
ws.Cells(rw, i).Value = Sheets(CStr(j)).Cells.Find(ws.Cells(1,
i)).Offset(1).Value
Sheets(CStr(j)).Cells.Find(ws.Cells(1, i)).Offset(1).ClearContents
Next i
Next j
End Sub
 
J

Joel

I hate Power Programming like the code you supplied. Power programming dates
back to thje 1960's and shouldn't be used. In the 1960's and early 70's
computers were very small and to get programs to run you tried to make the
programs as small as possible.

The idea back then was to to make variable names small and to put all the
code on as few lines as possible. the code was hard to understand.

Good programming practices are to document code so theat it can be
maintiained. Use veriable names that are are descriptive. Break code into
multiple lines so it it easily understood by all people not just the person
who wrote the code. Don't use tricks that people won't understand. Add
error checking like the test below for "If not c is nothing".


Option Explicit
Sub Summary()
Dim ws As Worksheet
Dim ShtCount As Long
Dim ColCount As Long
Dim LastRow As Long
Dim Newrow As Long
Dim Data As Variant
Dim NewData As Variant
Dim c As Variant

'set ws to be the summary sheet
Set ws = Sheets("Summary")

'find last row of data in summary sheet
'Rows.Count is the last row in the worksheet
'Look in column A starting in the last row of worksheet
'search up (xlup) until data is found
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'make New row the the first enpty cell in column A (row after LastRow)
Newrow = LastRow + 1

'search columns 1 t 7 on sheets 1 to 7
For ColCount = 1 To 7
For ShtCount = 1 To 7
'Get data in row 1 from summary sheet
Data = ws.Cells(1, ColCount)

'search for data in all the cells in the sheet specified
Set c = Sheets(ShtCount).Cells.Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)

'test if data is found
If Not c Is Nothing Then
'get the data in the cell directly below the data being search
for
NewData = c.Offset(rowoffset:=1, columnoffset:=0).Value
'Clear the cell where the data is being extracted from
c.Offset(rowoffset:=1, columnoffset:=0).ClearContents
'Put the data extract into the summary sheet
ws.Cells(Newrow, ColCount).Value = NewData
Newrow = Newrow + 1
End If
Next ShtCount
Next ColCount
End Sub
 
J

JLGWhiz

Option Explicit
'Requires all variables to be declared before runtime

Sub Summary() 'Title of procedure

Dim ws As Worksheet 'Declares ws as worksheet object

Dim i As Long, j As Long, rw As Long
'Declares three individual variables as long integers (numeric)

Set ws = Sheets("Summary") 'Sets ws variable to an object value

For j = 1 To 7 'Sets up a For loop and its parameter limits

rw = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
'assigns a value to the rw variable for last row number
'in column A

For i = 1 To 7 'Starts a second embedded For...Next loop

ws.Cells(rw, i).Value = Sheets(CStr(j)).Cells. _
'I do not know why the CStr function is used here but it
'converts the value of j to a string number. Maybe the
'sheet is named as a number. This set a cell in the last
'row equal to a value in row 2 of the same column.

Find(ws.Cells(1,i)).Offset(1).Value 'Looks the a value equal to
'the value in row 2 of the same column

Sheets(CStr(j)).Cells.Find(ws.Cells(1,
i)).Offset(1).ClearContents
'Deleteds the value in the cell just found.

Next i 'Sends to next iteration until limit is reached

Next j 'Sends to next iteration until limit is reached

End Sub 'Kaput
 
P

project manager

cheers, yours makes more sense but it puts the data in funny places in the
summary sheet, i need it to all line iup in one row under the headings i have.

sheets 1 to 7 are the slave data entry sheets and summary is where they all
get inputed into. the slave sheets have a heading in b2,c2,d2,b4,c4,d4,b6
and a data field underneath in b3,c3d3,b5,c5,d5,b7, this then needs to be
put into the summary sheet in this order.
 
P

project manager

getting a few errors when i run this one...

JLGWhiz said:
Option Explicit
'Requires all variables to be declared before runtime

Sub Summary() 'Title of procedure

Dim ws As Worksheet 'Declares ws as worksheet object

Dim i As Long, j As Long, rw As Long
'Declares three individual variables as long integers (numeric)

Set ws = Sheets("Summary") 'Sets ws variable to an object value

For j = 1 To 7 'Sets up a For loop and its parameter limits

rw = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
'assigns a value to the rw variable for last row number
'in column A

For i = 1 To 7 'Starts a second embedded For...Next loop

ws.Cells(rw, i).Value = Sheets(CStr(j)).Cells. _
'I do not know why the CStr function is used here but it
'converts the value of j to a string number. Maybe the
'sheet is named as a number. This set a cell in the last
'row equal to a value in row 2 of the same column.

Find(ws.Cells(1,i)).Offset(1).Value 'Looks the a value equal to
'the value in row 2 of the same column

Sheets(CStr(j)).Cells.Find(ws.Cells(1,
i)).Offset(1).ClearContents
'Deleteds the value in the cell just found.

Next i 'Sends to next iteration until limit is reached

Next j 'Sends to next iteration until limit is reached

End Sub 'Kaput
 
J

JLGWhiz

That is probably because I did not write anything to run. I tried to write
an explanation for each of the lines of code that you posted. Sorry, if I
misread your post.
 
J

JLGWhiz

I think it is a matter of philosopy in programming style. Some instructors
teach the reduction of characters in the actual code, although the reserved
space in memory is not affected by the size of the variale, the number of
bytes required to store the actual code is reduced. So, it depends on your
database manager's policy or the software manager's policy or both as to
what styles are used for commercial purposes. At home, you are the boss.
 
P

project manager

can you correct it to work?



JLGWhiz said:
That is probably because I did not write anything to run. I tried to write
an explanation for each of the lines of code that you posted. Sorry, if I
misread your post.
 
J

JLGWhiz

this should run. If it doen't, just look for line wraps, which should be
colored red, and put the overrun on the line above. When the red is gone, it
should be OK.

Option Explicit
'Requires all variables to be declared before runtime

Sub Summary() 'Title of procedure

Dim ws As Worksheet 'Declares ws as worksheet object

Dim i As Long, j As Long, rw As Long
'Declares three individual variables as long
'integers (numeric)

Set ws = Sheets("Summary") 'Sets ws variable to an
'object value

For j = 1 To 7 'Sets up a For loop and its parameter limits

rw = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
'assigns a value to the rw variable for last row number
'with data in column A and adds one so rw will be a blank row

For i = 1 To 7 'Starts a second embedded For...Next loop

ws.Cells(rw, i).Value = Sheets(CStr(j)).Cells. _
'I do not know why the CStr function is used here but it
'converts the value of j to a string number. Maybe the
'sheet is named as a number. This sets the value ofa cell
'in the last row equal to a value in row 2 of the same
'column.

Find(ws.Cells(1,i)).Offset(1).Value 'Looks for a value
'equal to the value in row 2 of the same column

Sheets(CStr(j)).Cells. _
Find(ws.Cells(1, i)).Offset(1).ClearContents
'Deleteds the value in the cell just found.

Next i 'Sends to next iteration until limit is reached

Next j 'Sends to next iteration until limit is reached

End Sub 'Kaput
 
J

Joel

I think I found the problem. I was caculating the Last row in the wrong
place in the macro. I just move some lines around. See if this is better.

Option Explicit
Sub Summary()
Dim ws As Worksheet
Dim ShtCount As Long
Dim ColCount As Long
Dim LastRow As Long
Dim Newrow As Long
Dim Data As Variant
Dim NewData As Variant
Dim c As Variant

'set ws to be the summary sheet
Set ws = Sheets("Summary")

'search columns 1 t 7 on sheets 1 to 7
For ColCount = 1 To 7
For ShtCount = 1 To 7
'Get data in row 1 from summary sheet
Data = ws.Cells(1, ColCount)

'search for data in all the cells in the sheet specified
Set c = Sheets(ShtCount).Cells.Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)

'test if data is found
If Not c Is Nothing Then

'find last row of data in summary sheet
'Rows.Count is the last row in the worksheet
'Look in column A starting in the last row of worksheet
'search up (xlup) until data is found
LastRow = ws.Cells(Rows.Count, ColCount).End(xlUp).Row
'make New row the the first enpty cell in column A (row after
LastRow)
Newrow = LastRow + 1


'get the data in the cell directly below the data being search
for
NewData = c.Offset(rowoffset:=1, columnoffset:=0).Value
'Clear the cell where the data is being extracted from
c.Offset(rowoffset:=1, columnoffset:=0).ClearContents
'Put the data extract into the summary sheet
ws.Cells(Newrow, ColCount).Value = NewData
End If
Next ShtCount
Next ColCount
End Sub
 
P

project manager

this one works better but it doesnt put the data automatically in first clear
/ next row.

Option Explicit
Sub Summary()
Dim ws As Worksheet
Dim ShtCount As Long
Dim ColCount As Long
Dim LastRow As Long
Dim Newrow As Long
Dim Data As Variant
Dim NewData As Variant
Dim c As Variant

'set ws to be the summary sheet
Set ws = Sheets("Summary")

'search columns 1 t 7 on sheets 1 to 7
For ColCount = 1 To 7
For ShtCount = 1 To 7
'Get data in row 1 from summary sheet
Data = ws.Cells(1, ColCount)

'search for data in all the cells in the sheet specified
Set c = Sheets(ShtCount).Cells.Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)

'test if data is found
If Not c Is Nothing Then

'find last row of data in summary sheet
'Rows.Count is the last row in the worksheet
'Look in column A starting in the last row of worksheet
'search up (xlup) until data is found
LastRow = ws.Cells(Rows.Count, ColCount).End(xlUp).Row
'make New row the the first enpty cell in column A (row after
LastRow)
Newrow = LastRow + 1


'get the data in the cell directly below the data being search
for
NewData = c.Offset(rowoffset:=1, columnoffset:=0).Value
'Clear the cell where the data is being extracted from
c.Offset(rowoffset:=1, columnoffset:=0).ClearContents
'Put the data extract into the summary sheet
ws.Cells(Newrow, ColCount).Value = NewData
End If
Next ShtCount
Next ColCount
End Sub
 
J

Joel

Did the original code work properly? Try this change. If it works I'm
confused, because it should give the same wrong results as my first try. But
with this change I'm doing exactly what your code did????????????? I'm
confused.

from:
LastRow = ws.Cells(Rows.Count, ColCount).End(xlUp).Row

to:
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
 
J

Joel

the code doesn't require any cells to be selected. I added two message boxes
to the code so you can find the problem. the message boxes will tell you
exactly what the code is doing at each step. See if this helps. Also try it
two different way. Change the line below and see if it works better. the
only real difference between my code and the oringal is I'm matching the
entire cell. Usually people arre looking to match entire cell. The default
which is in the original code is looking at part of the cell.

Here is a change to look at only part of the cell
from :
Set c = Sheets(ShtCount).Cells.Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)
to:
Set c = Sheets(ShtCount).Cells.Find(what:=Data, _
LookIn:=xlValues, lookat:=xlpart)

Below is a change to put the cell into a different destination cell

from (1st method) :
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
to (2nd method) :
LastRow = ws.Cells(Rows.Count, Colcount).End(xlUp).Row


Code below useds 1st method and has tow message boxes to help find problem.

Option Explicit
Sub Summary()
Dim ws As Worksheet
Dim ShtCount As Long
Dim ColCount As Long
Dim LastRow As Long
Dim Newrow As Long
Dim Data As Variant
Dim NewData As Variant
Dim c As Variant

'set ws to be the summary sheet
Set ws = Sheets("Summary")

'search columns 1 t 7 on sheets 1 to 7
For ColCount = 1 To 7
For ShtCount = 1 To 7
'Get data in row 1 from summary sheet
Data = ws.Cells(1, ColCount)

'search for data in all the cells in the sheet specified
Set c = Sheets(ShtCount).Cells.Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)

'test if data is found
If Not c Is Nothing Then

'find last row of data in summary sheet
'Rows.Count is the last row in the worksheet
'Look in column A starting in the last row of worksheet
'search up (xlup) until data is found
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
'make New row the the first enpty cell in column A
'(row after LastRow)
Newrow = LastRow + 1


'get the data in the cell directly
'below the data being search for
NewData = c.Offset(rowoffset:=1, columnoffset:=0).Value
'Clear the cell where the data is being extracted from
c.Offset(rowoffset:=1, columnoffset:=0).ClearContents
'Put the data extract into the summary sheet
ws.Cells(Newrow, ColCount).Value = NewData

MsgBox ("Found" & vbCrLf & _
"Data : " & Data & vbCrLf & _
"Sheet : " & ShtCount & vbCrLf & _
"Column : " & ColCount & vbCrLf & _
"Row : " & c.Row & vbCrLf & _
"Moving Data : " & NewData & vbCrLf & _
"From Row : " & (c.Row + 1) & vbCrLf & _
"Moving Data to Summary : " & _
ws.Cells(Newrow, ColCount).Address)
Else
MsgBox ("Did Not find" & vbCrLf & _
"Data : " & Data & vbCrLf & _
"Sheet : " & ShtCount & vbCrLf & _
"Column : " & ColCount)
End If
Next ShtCount
Next ColCount
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top