Possible VBA Code?

J

JLatham

I'm a little confused as to which way data is supposed to be moved. Looking
at your example, I'm thinking you want to get an email address from column A
of Sheet2 and place it into empty cells in column B of Sheet1.

Question is how to decide which one to pull. Is there a one-to-one
correspondence between the rows on both sheets. That is, if Sheet1!B3 is
empty, can we just get the address in Sheet2!B3 to put into it?

By any chance would the numbers shown as being in Sheet1, column A be found
 
C

Cathy Landry

Hello,

Sheet1 Column A will always contain a mm/yy (we use this for our corp card
programs exp date) Column B will always contain employees email add'y. So,
I'd like to create an email list in sheet2 of all email addresses where the
cells in ColA in Sheet1 are not null. Hope that makes sense :)
 
J

JLatham

Make a copy of your workbook and test this out in it first. Change the names
of the two worksheets in this code to whatever they're really called in the
workbook. To put the code where you can use it, press [Alt]+[F11] to open
the VB editor. Choose Insert >> Module from the VBE menu. Copy and paste
the code below into the module that appears, make the sheet name changes,
close the VB Editor and use it from Tools >> Macro >> Macros.

I assumed you wanted the email addresses to actually be email links, so I've
coded it that way.

Sub MakeEmailList()
Const sourceSheet = "Sheet1" ' change
Const emailListSheet = "Sheet2" ' change

Dim lastSourceRow As Long
Dim sourcePointer As Long
Dim srcRange As Range

Dim emailRange As Range
Dim emailPointer As Long

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
lastSourceRow = Worksheets(sourceSheet).Range("A" & _
Rows.Count).End(xlUp).Row
emailPointer = Worksheets(emailListSheet).Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
lastSourceRow = Worksheets(sourceSheet).Range("A" & _
Rows.CountLarge).End(xlUp).Row
emailPointer = Worksheets(emailListSheet).Range("A" & _
Rows.CountLarge).End(xlUp).Row
End If
Set srcRange = Worksheets(sourceSheet).Range("A1")
Set emailRange = Worksheets(emailListSheet).Range("A1")
Do While srcRange.Row + sourcePointer <= lastSourceRow
If Not IsEmpty(srcRange.Offset(sourcePointer, 0)) Then
'some entry in column A
'if also an entry in B, assume an email, copy it
If Not IsEmpty(srcRange.Offset(sourcePointer, 1)) Then
emailRange.Offset(emailPointer, 0).Hyperlinks.Add _
Anchor:=emailRange.Offset(emailPointer, 0), _
Address:="mailto:" & srcRange.Offset(sourcePointer, 1).Value, _
TextToDisplay:=srcRange.Offset(sourcePointer, 1).Value
emailPointer = emailPointer + 1
End If
End If
sourcePointer = sourcePointer + 1
Loop
End Sub
 
C

Cathy Landry

Works beautifully!!!!!!

Thank you :)


JLatham said:
Make a copy of your workbook and test this out in it first. Change the names
of the two worksheets in this code to whatever they're really called in the
workbook. To put the code where you can use it, press [Alt]+[F11] to open
the VB editor. Choose Insert >> Module from the VBE menu. Copy and paste
the code below into the module that appears, make the sheet name changes,
close the VB Editor and use it from Tools >> Macro >> Macros.

I assumed you wanted the email addresses to actually be email links, so I've
coded it that way.

Sub MakeEmailList()
Const sourceSheet = "Sheet1" ' change
Const emailListSheet = "Sheet2" ' change

Dim lastSourceRow As Long
Dim sourcePointer As Long
Dim srcRange As Range

Dim emailRange As Range
Dim emailPointer As Long

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
lastSourceRow = Worksheets(sourceSheet).Range("A" & _
Rows.Count).End(xlUp).Row
emailPointer = Worksheets(emailListSheet).Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
lastSourceRow = Worksheets(sourceSheet).Range("A" & _
Rows.CountLarge).End(xlUp).Row
emailPointer = Worksheets(emailListSheet).Range("A" & _
Rows.CountLarge).End(xlUp).Row
End If
Set srcRange = Worksheets(sourceSheet).Range("A1")
Set emailRange = Worksheets(emailListSheet).Range("A1")
Do While srcRange.Row + sourcePointer <= lastSourceRow
If Not IsEmpty(srcRange.Offset(sourcePointer, 0)) Then
'some entry in column A
'if also an entry in B, assume an email, copy it
If Not IsEmpty(srcRange.Offset(sourcePointer, 1)) Then
emailRange.Offset(emailPointer, 0).Hyperlinks.Add _
Anchor:=emailRange.Offset(emailPointer, 0), _
Address:="mailto:" & srcRange.Offset(sourcePointer, 1).Value, _
TextToDisplay:=srcRange.Offset(sourcePointer, 1).Value
emailPointer = emailPointer + 1
End If
End If
sourcePointer = sourcePointer + 1
Loop
End Sub


Cathy Landry said:
Hello,

Sheet1 Column A will always contain a mm/yy (we use this for our corp card
programs exp date) Column B will always contain employees email add'y. So,
I'd like to create an email list in sheet2 of all email addresses where the
cells in ColA in Sheet1 are not null. Hope that makes sense :)
Click to expand...
Click to expand...
 
J

JLatham

You're welcome, enjoy!

Cathy Landry said:
Works beautifully!!!!!!

Thank you :)


JLatham said:
Make a copy of your workbook and test this out in it first. Change the names
of the two worksheets in this code to whatever they're really called in the
workbook. To put the code where you can use it, press [Alt]+[F11] to open
the VB editor. Choose Insert >> Module from the VBE menu. Copy and paste
the code below into the module that appears, make the sheet name changes,
close the VB Editor and use it from Tools >> Macro >> Macros.

I assumed you wanted the email addresses to actually be email links, so I've
coded it that way.

Sub MakeEmailList()
Const sourceSheet = "Sheet1" ' change
Const emailListSheet = "Sheet2" ' change

Dim lastSourceRow As Long
Dim sourcePointer As Long
Dim srcRange As Range

Dim emailRange As Range
Dim emailPointer As Long

If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
lastSourceRow = Worksheets(sourceSheet).Range("A" & _
Rows.Count).End(xlUp).Row
emailPointer = Worksheets(emailListSheet).Range("A" & _
Rows.Count).End(xlUp).Row
Else
'in Excel 2007 (or later)
lastSourceRow = Worksheets(sourceSheet).Range("A" & _
Rows.CountLarge).End(xlUp).Row
emailPointer = Worksheets(emailListSheet).Range("A" & _
Rows.CountLarge).End(xlUp).Row
End If
Set srcRange = Worksheets(sourceSheet).Range("A1")
Set emailRange = Worksheets(emailListSheet).Range("A1")
Do While srcRange.Row + sourcePointer <= lastSourceRow
If Not IsEmpty(srcRange.Offset(sourcePointer, 0)) Then
'some entry in column A
'if also an entry in B, assume an email, copy it
If Not IsEmpty(srcRange.Offset(sourcePointer, 1)) Then
emailRange.Offset(emailPointer, 0).Hyperlinks.Add _
Anchor:=emailRange.Offset(emailPointer, 0), _
Address:="mailto:" & srcRange.Offset(sourcePointer, 1).Value, _
TextToDisplay:=srcRange.Offset(sourcePointer, 1).Value
emailPointer = emailPointer + 1
End If
End If
sourcePointer = sourcePointer + 1
Loop
End Sub


Cathy Landry said:
Hello,

Sheet1 Column A will always contain a mm/yy (we use this for our corp card
programs exp date) Column B will always contain employees email add'y. So,
I'd like to create an email list in sheet2 of all email addresses where the
cells in ColA in Sheet1 are not null. Hope that makes sense :)

:

I'm a little confused as to which way data is supposed to be moved. Looking
at your example, I'm thinking you want to get an email address from column A
of Sheet2 and place it into empty cells in column B of Sheet1.

Question is how to decide which one to pull. Is there a one-to-one
correspondence between the rows on both sheets. That is, if Sheet1!B3 is
empty, can we just get the address in Sheet2!B3 to put into it?

By any chance would the numbers shown as being in Sheet1, column A be found
on Sheet2 in association with the appropriate email addresses?


:

Hello,
I have a worksheet with detail data in sheet1 that I'd like to pull over
email add'y in sheet2 if cells in colA are null. Can this be done via a
formula or vba? I'm currently using a pivot table but because we have such a
large volume of data we have poor performance.

COL A COL B COL A (sheet2)
0609 [email protected] [email protected]
0609 [email protected] [email protected]
0607 [email protected]
0609 [email protected]

Thank you!
Cathy
Click to expand...
Click to expand...
Click to expand...
 
Top