Search in columns and return value

[colaps]

Hi,

I have a situation and it seems i can`t do it, goes like this:

sheet2 i have a header with weeks from WK01 to WK10
under each WK i have to have values.

The values will come from sheet1 , same format of the header but in some cases i will not have same starting week number
Ex. this week i have the header WK02 to WK10, next several day i will have WK03 to WK04 etc. under each WK i have a value.

the problem i`m facing is : i need a loop that goes through every header values from sheet1 and checks if these are matching with header from sheet2
ex. WK02 = WK02, WK05 = WK 05 , if they match the corresponding value that is under WK02 in sheet1 will be copied in the corresponding WK number in sheet2.

I hope is clear enough what i`m trying to do.

thank you.

 

[Toadstool]

Hi Colaps,

Does this do what you ask?

Here's my Sheet2

Colaps.xlsx
	A	B	C	D	E	F	G	H	I	J
1	WK01	WK02	WK03	WK04	WK05	WK06	WK07	WK08	WK09	WK10
2	11	22	33	44	55	66	77	88	99	111
Sheet2

Here's Sheet1 with the retrieval formula.

Colaps.xlsx
	A	B	C	D	E	F
1	WK02	WK03	WK04	WK07	WK08	WK09
2	22	33	44	77	88	99
Sheet1

Cell Formulas
Range	Formula
A2:F2	A2	=INDEX(Sheet2!2:2,MATCH(Sheet1!A1,Sheet2!1:1,0))

 

[maabadi]

Please Upload your example file & Desired Results with XL2BB ADDIN (Preferable) or upload at free hosting site e.g. www.dropbox.com , GoogleDrive or Onedrive and Insert Link here.

 

[colaps]

hi :
this is sheet1

WK 02	WK 03	WK 04
8000	9000	15000

this is sheet2

WK 01	WK 02	WK 03	WK 04

i need a vba that compares the haders from sheet2 with sheet1 and returns the value that matches the name ( WK 01 on both sheets , or in case of no match it will return in sheet2 0 , if WK 02 is found in both sheets, it will return the value found in sheet1 under wk 02 )


Expected result :

WK 01	WK 02	WK 03	WK 04
0	8000	9000	15000
0	0	150	200
0	0	0	154440

The sheet1 will be populated with other data and this needs to be cumulated on sheet2

 

[maabadi]

Try this:

Sub TransferData()
Dim I As Long, Lr1 As Long, Lr2 As Long, C As Long, j As Long, k As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook
Application.ScreenUpdating = False
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")
LC1 = Sh1.Cells(1, Columns.Count).End(xlToLeft).Column
LC2 = Sh2.Cells(1, Columns.Count).End(xlToLeft).Column
For I = 1 To LC1
For j = 1 To LC2
If Sh2.Cells(1, j).Value = Sh1.Cells(1, I).Value Then
Sh2.Cells(2, j).Value = Sh1.Cells(2, I).Value
End If
Next j
Next I
Application.ScreenUpdating = True
End Sub

 

[colaps]

Try this:

Sub TransferData()
Dim I As Long, Lr1 As Long, Lr2 As Long, C As Long, j As Long, k As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook
Application.ScreenUpdating = False
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")
LC1 = Sh1.Cells(1, Columns.Count).End(xlToLeft).Column
LC2 = Sh2.Cells(1, Columns.Count).End(xlToLeft).Column
For I = 1 To LC1
For j = 1 To LC2
If Sh2.Cells(1, j).Value = Sh1.Cells(1, I).Value Then
Sh2.Cells(2, j).Value = Sh1.Cells(2, I).Value
End If
Next j
Next I
Application.ScreenUpdating = True
End Sub

it`s working but it`s not writing the 0 (zeros ) where is no match and in case i run again the macro with different data in sheet1, it overwrites instead of writing the new values under the existing data.

 

[maabadi]

Try this:
What means overwrite?

Sub TransferData()
Dim I As Long, Lr1 As Long, Lr2 As Long, C As Long, j As Long, k As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook
Application.ScreenUpdating = False
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")
LC1 = Sh1.Cells(1, Columns.Count).End(xlToLeft).Column
LC2 = Sh2.Cells(1, Columns.Count).End(xlToLeft).Column
For I = 1 To LC1
For j = 1 To LC2
If Sh2.Cells(1, j).Value = Sh1.Cells(1, I).Value Then
Sh2.Cells(2, j).Value = Sh1.Cells(2, I).Value
End If
If j > 1 Then
If Sh2.Cells(2, j - 1).Value = "" Then Sh2.Cells(2, j - 1).Value = 0
End If
Next j
Next I
Application.ScreenUpdating = True
End Sub

 

[colaps]

if i run again the macro with different data , on sheet2 , the first introduced data is getting overwrited by the new one .

there will be more runs and the result should look like :

WK 01	WK 02	WK 03	WK 04
0	35560	9000	1234
0	0	80000	50000
0	0	0	54300
67900	54000	32211	4000

 

[colaps]

sry for the doublepost,

i think i solved it myself :

Sub TransferData_working()

Dim I As Long, Lr1 As Long, Lr2 As Long, C As Long, j As Long, k As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook
Dim bott As Long

Application.ScreenUpdating = False
Set Sh1 = Sheets("sh")
Set Sh2 = Sheets("sh2")

bott = Sh2.Range("A" & Sh2.Rows.Count).End(xlUp).Row
bott = bott + 1


LC1 = Sh1.Cells(1, Columns.Count).End(xlToLeft).Column
LC2 = Sh2.Cells(1, Columns.Count).End(xlToLeft).Column

For I = 1 To LC1
For j = 1 To LC2

If Sh2.Cells(1, j).Value = Sh1.Cells(1, I).Value Then
Sh2.Cells(bott, j).Value = Sh1.Cells(2, I).Value
End If
If j > 1 Then
If Sh2.Cells(bott, j - 1).Value = "" Then Sh2.Cells(bott, j - 1).Value = 0

End If
Next j
Next I
Application.ScreenUpdating = True

End Sub

it`s now reading the last copied cell and writes the next data set under it.

Any ways , many thanks for the help !!!
@maabadi Thanks.

 

[maabadi]

Try this:

Sub TransferData()
Dim I As Long, LC1 As Long, LC2 As Long, C As Long, j As Long, k As Long, Lr1 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook
Application.ScreenUpdating = False
Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")
LC1 = Sh1.Cells(1, Columns.Count).End(xlToLeft).Column
LC2 = Sh2.Cells(1, Columns.Count).End(xlToLeft).Column
Lr1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row
For I = 1 To LC1
For j = 1 To LC2
If Sh2.Cells(1, j).Value = Sh1.Cells(1, I).Value Then
For k = 2 To Lr1
Sh2.Cells(k, j).Value = Sh1.Cells(k, I).Value
If j > 1 Then
If Sh2.Cells(k, j - 1).Value = "" Then Sh2.Cells(k, j - 1).Value = 0
End If
Next k
End If
Next j
Next I
For k = 2 To Lr1
If Sh2.Cells(k, LC2).Value = "" Then Sh2.Cells(k, LC2).Value = 0
Next k
Application.ScreenUpdating = True
End Sub