Interesting one-copying discrete lines from a dataset

fidgen

New Member
Joined
Aug 20, 2002
Messages
46
Hiya,

I have a spreadsheet (sheet1) containing 26 columns and 1000+ rows of data. Column A is date, the other 25 are bird species, and the cells relate to how many birds were seen on that day.

But what i want to do is a little complex:

A second spreadsheet has 45 columns of data, the first one is date ,and the next 25 columns relate to the 25 in sheet1, the next 19 are birstrike information (ie when and how the bird hit the plane)

If the birdstrike occurred in column 3 (crow) then there would be a 1 in that cell, but 0's in all the other cells of that row.

with me?

oh it gets worse...

I want to make a macro that searches along the rows in sheet2, columns 2:26, and when until it finds a 1 it needs to go back to column A, match the date with column A in sheet 1 and pull out the data in the corresponding cell in sheet1 into column 46 in sheet 2.

here's my attempt, very messy and long, but it was the only way i could get close (after a days fiddling)

Sub Strikeupdate3()
For A = 2 To 5000
If Worksheets("Strikes2").Cells(A, 1) = "" Then
Exit Sub
End If

If Worksheets("strikes2").Cells(A, 1) = Worksheets("Data").Cells(A, 1) Then
GoTo Line2
End If

Line2:
If Worksheets("strikes2").Cells(A, 2) = 1 Then
GoTo Line3
Else: GoTo Line28
End If

Line28:
If Worksheets("strikes2").Cells(A, 3) = "1" Then
GoTo Line4
Else: GoTo Line29
End If

Line29:
If Worksheets("strikes2").Cells(A, 4) = "1" Then
GoTo Line5
Else: GoTo Line30
End If

Line30:
If Worksheets("strikes2").Cells(A, 5) = "1" Then
GoTo Line6
Else: GoTo Line31
End If

Line31:
If Worksheets("strikes2").Cells(A, 6) = "1" Then
GoTo Line7
Else: GoTo Line32
End If

Line32:
If Worksheets("strikes2").Cells(A, 7) = "1" Then
GoTo Line8
Else: GoTo Line33
End If

Line33:
If Worksheets("strikes2").Cells(A, :cool: = "1" Then
GoTo Line9
Else: GoTo Line34
End If

Line34:
If Worksheets("strikes2").Cells(A, 9) = "1" Then
GoTo Line10
Else: GoTo Line35
End If

Line35:
If Worksheets("strikes2").Cells(A, 10) = "1" Then
GoTo Line11
Else: GoTo Line36
End If

Line36:
If Worksheets("strikes2").Cells(A, 11) = "1" Then
GoTo Line12
Else: GoTo Line37
End If

Line37:
If Worksheets("strikes2").Cells(A, 12) = "1" Then
GoTo Line13
Else: GoTo Line38
End If

Line38:
If Worksheets("strikes2").Cells(A, 13) = "1" Then
GoTo Line14
Else: GoTo Line39
End If

Line39:
If Worksheets("strikes2").Cells(A, 14) = "1" Then
GoTo Line15
Else: GoTo Line40
End If

Line40:
If Worksheets("strikes2").Cells(A, 15) = "1" Then
GoTo Line16
Else: GoTo Line41
End If

Line41:
If Worksheets("strikes2").Cells(A, 16) = "1" Then
GoTo Line17
Else: GoTo Line42
End If

Line42:
If Worksheets("strikes2").Cells(A, 17) = "1" Then
GoTo Line18
Else: GoTo Line43
End If

Line43:
If Worksheets("strikes2").Cells(A, 18) = "1" Then
GoTo Line19
Else: GoTo Line44
End If

Line44:
If Worksheets("strikes2").Cells(A, 19) = "1" Then
GoTo Line20
Else: GoTo Line45
End If

Line45:
If Worksheets("strikes2").Cells(A, 20) = "1" Then
GoTo Line21
Else: GoTo Line46
End If

Line46:
If Worksheets("strikes2").Cells(A, 21) = "1" Then
GoTo Line22
Else: GoTo Line47
End If

Line47:
If Worksheets("strikes2").Cells(A, 22) = "1" Then
GoTo Line23
Else: GoTo Line48
End If

Line48:
If Worksheets("strikes2").Cells(A, 23) = "1" Then
GoTo Line24
Else: GoTo Line49
End If

Line49:
If Worksheets("strikes2").Cells(A, 24) = "1" Then
GoTo Line25
Else: GoTo Line50
End If

Line50:
If Worksheets("strikes2").Cells(A, 25) = "1" Then
GoTo Line26
Else: GoTo Line51
End If

Line51:
If Worksheets("strikes2").Cells(A, 26) = "1" Then
GoTo Line27
End If

Line3:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 2)

Line4:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 3)

Line5:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 4)

Line6:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 5)

Line7:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 6)

Line8:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 7)

Line9:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, :cool:

Line10:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 9)

Line11:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 10)

Line12:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 11)

Line13:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 12)

Line14:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 13)

Line15:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 14)

Line16:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 15)

Line17:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 16)

Line18:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 17)

Line19:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 18)

Line20:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 19)

Line21:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 20)

Line22:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 21)

Line23:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 22)

Line24:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 23)

Line25:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 24)

Line26:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 25)

Line27:
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, 26)


Next
End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Hi,

I think your code can be reduced to:<pre>
Sub Strikeupdate()
A = 2
While Worksheets("Strikes2").Cells(A, 1)<> ""
For B = 1 To 26
If Worksheets("strikes2").Cells(A, B) = 1 Then
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, B)
End If
Next B
A = A + 1
Wend
End Sub</pre>

Q: What if there are more 1's on a row? It seems that you are only interested in the last 1 in the same row.
This message was edited by rikrak on 2002-10-01 10:42
 
Upvote 0
hiya - each line will only have the one 1 in it, so that is not the problem.

Your code works fine, except that "A" in "strikes2" and "data" are not the same unfortunately. Strikes2 is a summary sheet of data with single rows picked out - so row 2 of strikes2 may match row 2 in data, but row 3 of strikes2 can be row 987 of data, The common thing to both rows however would be the date in column A. - So I need the macro to match the cells with the "1" in by looking for column, and then for row by using the date.

Is this possible?

Thanks for your time!

Hugh
 
Upvote 0
This is what i've come up with from your code - obviously still doesn't work (that would be too much to hope) but it shows what I want to do.



Thanks
Hugh




Sub Strikeupdate3()
A = 2
For C = 2 To 5000
While Worksheets("Strikes2").Cells(A, 1) <> ""
For B = 2 To 26
If Worksheets("strikes2").Cells(A, 1) = Worksheets("data").Cells(C, 1) Then
C = A
End If
If Worksheets("strikes2").Cells(A, B) = 1 Then
Worksheets("strikes2").Cells(A, 42) = Worksheets("Data").Cells(A, B)
End If
Next B
A = A + 1
Wend
Next C
End Sub
 
Upvote 0
Here is the code I used to solve the problem - it matches the values in column A in both spreadsheets, and then once a match is found it finds the correct column and then copies the value from one sheet to a specific cell in the other.




Sub StrikeUpdate3()

X = 2
For A = 2 To 5000
If Worksheets("strikes2").Cells(A, 1) = "" Then
Exit For
End If

DateStrikes2 = Worksheets("strikes2").Cells(A, 1)

For B = X To 5000

DateData = Worksheets("Data").Cells(B, 1)

If DateData = DateStrikes2 Then
For C = 2 To 26
If Worksheets("strikes2").Cells(A, C) = 1 Then
Worksheets("strikes2").Cells(A, 42) = Worksheets("data").Cells(B, C)
Exit For
End If

Next 'C
Exit For
End If

Next 'B
X = B
Next 'A

End Sub
 
Upvote 0

Forum statistics

Threads
1,214,833
Messages
6,121,864
Members
449,052
Latest member
Fuddy_Duddy

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