If value(s) in row, then copy to new cell(s)

[im2bz2p345]

Hi all,

I have a very large spreadsheet and I made a small example from it:

Sheet1

*	A	B	C	D	E	F	G	H	I	J	K
1	Facility1	Facility2	Facility3	Facility4	*	What I need	*
2	600	Nursing Admin - Adult	600	Nursing Admin.	600	Nursing Admin.	600	Nursing Admin.	*	600	Nursing Admin.
3	*	*	601	Nursing Supervisor	*	*	*	*	*	601	Nursing Supervisor
4	602	Nursing Admin - Childrens	*	*	*	*	*	*	*	602	Nursing Admin - Childrens
5	603	Nursing Interns	*	*	*	*	603	Nursing Interns	*	603	Nursing Interns

<COLGROUP><COL style="FONT-WEIGHT: bold; WIDTH: 30px"><COL style="WIDTH: 36px"><COL style="WIDTH: 194px"><COL style="WIDTH: 36px"><COL style="WIDTH: 143px"><COL style="WIDTH: 36px"><COL style="WIDTH: 116px"><COL style="WIDTH: 36px"><COL style="WIDTH: 116px"><COL style="WIDTH: 64px"><COL style="WIDTH: 83px"><COL style="WIDTH: 64px"></COLGROUP><TBODY>
</TBODY>

In this example, I only have four facilities, but in my original file there are a ton (30+). In J2, this is what I need a formula or macro to do: search the entire row (A2:H2). If a value is found, copy the value (wherever it's found), then paste it in J2 & K2.

In J3, it would would search A3:H4, it would find the a value in C2 & D2, so it would need to copy those values in J2 and K2.


I can't do a simple =IF(ISVALUE()) because of sheer size of my original spreadsheet - as stated earlier there are 30+ facilities (there is information past column AD).

Hope there is someone that can help me out! Thanks in advance.

~ Im2bz2p345

 

[mcorriga]

Hi all,

I have a very large spreadsheet and I made a small example from it:

Sheet1

*	A	B	C	D	E	F	G	H	I	J	K
1	Facility1	Facility2	Facility3	Facility4	*	What I need	*
2	600	Nursing Admin - Adult	600	Nursing Admin.	600	Nursing Admin.	600	Nursing Admin.	*	600	Nursing Admin.
3	*	*	601	Nursing Supervisor	*	*	*	*	*	601	Nursing Supervisor
4	602	Nursing Admin - Childrens	*	*	*	*	*	*	*	602	Nursing Admin - Childrens
5	603	Nursing Interns	*	*	*	*	603	Nursing Interns	*	603	Nursing Interns

<TBODY>
</TBODY>

In this example, I only have four facilities, but in my original file there are a ton (30+). In J2, this is what I need a formula or macro to do: search the entire row (A2:H2). If a value is found, copy the value (wherever it's found), then paste it in J2 & K2.

In J3, it would would search A3:H4, it would find the a value in C2 & D2, so it would need to copy those values in J2 and K2.


I can't do a simple =IF(ISVALUE()) because of sheer size of my original spreadsheet - as stated earlier there are 30+ facilities (there is information past column AD).

Hope there is someone that can help me out! Thanks in advance.

~ Im2bz2p345

Hey,

This code is pretty bad but it might work for you. Change i to the number of rows in your spreadsheet (like I said, bad code). I used 31 as the column number assuming your values will go in AE and AF since you said AD was the last used column. Change that number as well if that assumption is incorrect. Good luck, sorry I don't have time to explain it much better at the moment but if you try it let me know if it does/doesn't work.
Sub test()
Application.Range("A2").Select
i = 10
Do Until i = 0
Do Until ActiveCell.Column >= 31
val1 = ActiveCell.Value
If Not IsEmpty(val1) Then
ActiveCell.Offset(0, 1).Select
val2 = ActiveCell.Value
'add value to AE and AF now
curRow = ActiveCell.Row
curColumn = ActiveCell.Column
Application.Range("AE" & curRow).Select
ActiveCell.Value = val1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = val2
Application.Range("A" & curRow).Select
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(0, 2).Select
curColumn = ActiveCell.Column
End If
Loop
curRow = ActiveCell.Row
Application.Range("A" & curRow).Select
ActiveCell.Offset(1, 0).Select
i = i - 1
Loop

 

[mcorriga]

There should be an end sub on there too

Sub test()
Application.Range("A2").Select
i = 10
Do Until i = 0
Do Until ActiveCell.Column >= 31
val1 = ActiveCell.Value
If Not IsEmpty(val1) Then
ActiveCell.Offset(0, 1).Select
val2 = ActiveCell.Value
'add value to AE and AF now
curRow = ActiveCell.Row
curColumn = ActiveCell.Column
Application.Range("AE" & curRow).Select
ActiveCell.Value = val1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = val2
Application.Range("A" & curRow).Select
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(0, 2).Select
curColumn = ActiveCell.Column
End If
Loop
curRow = ActiveCell.Row
Application.Range("A" & curRow).Select
ActiveCell.Offset(1, 0).Select
i = i - 1
Loop
End Sub

 

[im2bz2p345]

Appologies for the really late reply - but this worked GREAT mcorriga!

I obviously had to modify the data on my worksheet a bit for it to work, but I believe it did it's job!

I'll try to decipher your code a bit further as I get a chance. One suggestion for the future is to add these line before and after your code, which will speed up operations quite a bit:

Sub Test()
Application.ScreenUpdating = False
....*YOUR CODE*....
Application.ScreenUpdating = True
End Sub

Thanks again for your help on this!!

~ Im2bz2p345

 

[im2bz2p345]

It took about 15 seconds with your code the way it is.

If you toggle ScreenUpdating before & after your code, it takes less than 1 second to complete. This is because Excel doesn't have to bother with "showing the user what it is doing."

Hope this helps,

~ Im2bz2p345