Small adjustment to existing VBA copy macro

[evenyougreg]

Hi all,

I have this VBA code that used to work perfect, but I recently had to add a new column and so it needs to be adjusted, but no combination of adjustments I've attempted is correct.

Basically if there is a hostname match in A, I need to copy over K and L

But if there is a hostname match in A, and, B has the string "NONE" then I need to copy over H I J K L

Here's the code that I've been using:

Sub copy_me_5000()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("from_here.xlsx").Sheets("old")
Set sh2 = Workbooks("to_here.xlsx").Sheets("new")
    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                If fn.Offset(, 1) = "NONE" Then c.Offset(, 4).Copy fn.Offset(, 4)
                c.Offset(, 8).Resize(, 4).Copy fn.Offset(, 8)
            End If
        Set fn = Nothing
    Next
End Sub

copy from here

from_here.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	hostname	minion	VM OS	check1	Grain OS	check2	location	P/F	Status	Env	Owner	Notes
2	m-demo1	m-demo1	Microsoft Windows Server 2012 (64-bit)	CMPTBL	Windows-2012ServerR2	CMPTBL	vcenter1	PASS	INSTALLED	prod
3	m-demo2	m-demo2	Microsoft Windows Server 2016 or later (64-bit)	CMPTBL	Windows-2016Server	CMPTBL	vcenter1	PASS	INSTALLED	test
4	m-demo4	m-demo4	Microsoft Windows Server 2012 (64-bit)	CMPTBL	Windows-2012ServerR2	CMPTBL	vcenter1	NOT ME	NOT ME	NOT ME	COPY ME	COPY ME
5	m-demo5	m-demo5	Microsoft Windows Server 2016 or later (64-bit)	CMPTBL	Windows-2019Server	CMPTBL	vcenter2	PASS	INSTALLED	dev
6	l-demo1	NONE	SUSE Linux Enterprise 11 (64-bit)	UNSTBL	unknown	UNDFND	vcenter1	FAIL	UNDEFINED	unknown			NOT ME
7	l-demo2	NONE	SUSE Linux Enterprise 11 (64-bit)	UNSTBL	unknown	UNDFND	vcenter1	FAIL	UNDEFINED	unknown
8	l-demo3	NONE	VMware Photon OS (64-bit)	UNSTBL	unknown	UNDFND	vcenter2	COPY ME	COPY ME	COPY ME	COPY ME	COPY ME
9	l-demo4	NONE	CentOS 4/5 or later (64-bit)	UNDFND	unknown	UNDFND	vcenter2	FAIL	UNDEFINED	unknown
10	l-demo5	NONE	Ubuntu Linux (64-bit)	CMPTBL	unknown	UNDFND	vcenter2	FAIL	UNDEFINED	unknown
11	l-demo6	NONE	Ubuntu Linux (64-bit)	CMPTBL	unknown	UNDFND	vcenter1	FAIL	UNDEFINED	unknown
old

to here

to_here.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	hostname	minion	VM OS	check1	Grain OS	check2	location	P/F	Status	Env	Owner	Notes
2	m-demo1	m-demo1	Microsoft Windows Server 2012 (64-bit)	CMPTBL	Windows-2012ServerR2	CMPTBL	vcenter1	PASS	INSTALLED	prod
3	m-demo2	m-demo2	Microsoft Windows Server 2016 or later (64-bit)	CMPTBL	Windows-2016Server	CMPTBL	vcenter1	PASS	INSTALLED	test
4	m-demo3	m-demo3	Microsoft Windows Server 2016 or later (64-bit)	CMPTBL	Windows-2016Server	CMPTBL	vcenter2	PASS	INSTALLED	prod
5	m-demo4	m-demo4	Microsoft Windows Server 2012 (64-bit)	CMPTBL	Windows-2012ServerR2	CMPTBL	vcenter1	PASS	INSTALLED	prod
6	m-demo5	m-demo5	Microsoft Windows Server 2016 or later (64-bit)	CMPTBL	Windows-2019Server	CMPTBL	vcenter2	PASS	INSTALLED	dev
7	l-demo1	NONE	SUSE Linux Enterprise 11 (64-bit)	UNSTBL	unknown	UNDFND	vcenter1	FAIL	UNDEFINED	unknown
8	l-demo2	NONE	SUSE Linux Enterprise 11 (64-bit)	UNSTBL	unknown	UNDFND	vcenter1	FAIL	UNDEFINED	unknown
9	l-demo3	NONE	VMware Photon OS (64-bit)	UNSTBL	unknown	UNDFND	vcenter2	FAIL	UNDEFINED	unknown
10	l-demo4	NONE	CentOS 4/5 or later (64-bit)	UNDFND	unknown	UNDFND	vcenter2	FAIL	UNDEFINED	unknown
11	l-demo5	NONE	Ubuntu Linux (64-bit)	CMPTBL	unknown	UNDFND	vcenter2	FAIL	UNDEFINED	unknown
Sheet1

 

[Fluff]

How about

Sub copy_me_5000()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("from_here.xlsx").Sheets("old")
Set sh2 = Workbooks("to_here.xlsx").Sheets("new")
    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                If fn.Offset(, 1) = "NONE" Then
                  c.Offset(, 7).Resize(, 5).Copy fn.Offset(, 7)
                Else
                  c.Offset(, 10).Resize(, 2).Copy fn.Offset(, 10)
                End If
            End If
        Set fn = Nothing
    Next
End Sub

 

[evenyougreg]

How about

Sub copy_me_5000()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("from_here.xlsx").Sheets("old")
Set sh2 = Workbooks("to_here.xlsx").Sheets("new")
    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                If fn.Offset(, 1) = "NONE" Then
                  c.Offset(, 7).Resize(, 5).Copy fn.Offset(, 7)
                Else
                  c.Offset(, 10).Resize(, 2).Copy fn.Offset(, 10)
                End If
            End If
        Set fn = Nothing
    Next
End Sub

Thanks Fluff! You're a lifesaver

 

[Fluff]

You're welcome & thanks for the feedback.

 

[evenyougreg]

@Fluff I forgot I also need E copied over if the second condition is true:

"But if there is a hostname match in A, and, B has the string "NONE" then I need to copy over E H I J K L"

Sorry!

 

[Fluff]

Ok, how about

Sub copy_me_5000()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range
Set sh1 = Workbooks("from_here.xlsx").Sheets("old")
Set sh2 = Workbooks("to_here.xlsx").Sheets("new")
    For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
        Set fn = sh2.Range("A:A").Find(c.Value, , xlValues, xlWhole)
            If Not fn Is Nothing Then
                If fn.Offset(, 1) = "NONE" Then
                  c.Offset(, 4).Copy fn.Offset(, 4)
                  c.Offset(, 7).Resize(, 5).Copy fn.Offset(, 7)
                Else
                  c.Offset(, 10).Resize(, 2).Copy fn.Offset(, 10)
                End If
            End If
        Set fn = Nothing
    Next
End Sub

 

[evenyougreg]

Thank you!

 

[Fluff]

My pleasure.