Need Code Modification

Minerva7 · Apr 22, 2019

Hello,

I was wondering if someone could look at my code and let me know how to modify this so that when Excel cannot find an entry in the SOURCE workbook, it pastes a zero for the corresponding group/item in the destination workbook (DailyBugCount). Currently, it moves to the next item when this happens, which is ok. It would be far more efficient if I didn't have to replace all those zero's manually in my report.

I know it's crude (I'm a VBA beginner), so be gentle. This example is for Analytics, which consists of three groups (Analytics - Default, Analytics = Analysts, and Analytics - Engineers). I'm finding values for bug count for each in the SOURCE workbook, then pasting values for these groups in the destination workbook (DailyBugCount_MASTER):

Sub FindCopyPasteSpecial()

Dim rFound As Range
Dim c

On Error Resume Next

Application.ScreenUpdating = False

'Analytics - Default
Workbooks("SOURCE.xlsx").Activate
With Sheets("Data").Columns(1)
Set rFound = .Find(What:="Analytics - Default", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If rFound Is Nothing Then Resume Next
rFound(1, 2).Copy

Workbooks("DailyBugCount_MASTER.xlsm").Activate
Sheets("ANALYTICS").Select
'Be sure the following range corresponds to the correct department in destination file
For Each c In Range("B9:AM9").Cells
If c = "" Then
c.Select
Exit For

End If
Next
With ActiveCell
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
End With

'Analytics - Analysts
Workbooks("SOURCE.xlsx").Activate
With Sheets("Data").Columns(1)
Set rFound = .Find(What:="Analytics - Analysts", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If rFound Is Nothing Then Resume Next
rFound(1, 2).Copy

Workbooks("DailyBugCount_MASTER.xlsm").Activate
Sheets("ANALYTICS").Select
'Be sure the following range corresponds to the correct department in destination file
For Each c In Range("B10:AM10").Cells
If c = "" Then
c.Select
Exit For

End If
Next
With ActiveCell
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
End With

'Analytics - Engineers
Workbooks("SOURCE.xlsx").Activate
With Sheets("Data").Columns(1)
Set rFound = .Find(What:="Analytics - Engineers", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If rFound Is Nothing Then Resume Next
rFound(1, 2).Copy

Workbooks("DailyBugCount_MASTER.xlsm").Activate
Sheets("ANALYTICS").Select
'Be sure the following range corresponds to the correct department in destination file
For Each c In Range("B11:AM11").Cells
If c = "" Then
c.Select
Exit For

End If
Next
With ActiveCell
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
End With

Application.ScreenUpdating = True

End Sub



Thanks in advance for any help you can offer.

Michael M · Apr 22, 2019

Do you mean here ??

Code:

Workbooks("DailyBugCount_MASTER.xlsm").Activate
Sheets("ANALYTICS").Select
'Be sure the following range corresponds to the correct department in destination file
For Each c In Range("B9:AM9").Cells
[color=red]If c = "" Then
c.value =0[/color]
Exit For

Also how many rows are required to be checked / modified......B? / AM?

Minerva7 · Apr 22, 2019

Michael M said:
Do you mean here ??

Code:

Workbooks("DailyBugCount_MASTER.xlsm").Activate Sheets("ANALYTICS").Select 'Be sure the following range corresponds to the correct department in destination file For Each c In Range("B9:AM9").Cells [COLOR=red]If c = "" Then c.value =0[/COLOR] Exit For

Also how many rows are required to be checked / modified......B? / AM?

That's it!

Thank you so much Michael! I feel kind of silly now. >.>

I really appreciate the help. To answer your question, there are three rows being checked here (columns B through AM). Just tried your modification, and it works great. Thanks again.

Minerva7 · Apr 22, 2019

Minerva7 said:
That's it! Thank you so much Michael! I feel kind of silly now. >.>

I really appreciate the help. To answer your question, there are three rows being checked here (columns B through AM). Just tried your modification, and it works great. Thanks again.

Darn. I take that back. I tested this out on a day when ALL of Analytics had zero bugs.

My fault.

What I'm trying to do is have the code place a zero only for those groups that are not found in source data. For example, some days Analytics - Engineers have no bugs. So for that day, my source data will not include Analytics - Engineers. Groups with zero bugs on any particular day are dropped from source data. My original code works well, but it leaves behind blank cells (instead of zeros) for those groups that are not found in source workbook.

Hopefully, that makes sense.

Michael M · Apr 22, 2019

Ok, if we take a step back and just check YOUR code and get it working

Code:

Sub FindCopyPasteSpecial()

Dim rFound As Range
Dim c

On Error Resume Next

Application.ScreenUpdating = False

'Analytics - Default
Workbooks("SOURCE.xlsx").Activate
With Sheets("Data").Columns(1)
Set rFound = .Find(What:="Analytics - Default", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If rFound Is Nothing Then Resume Next
rFound(1, 2).Copy

Workbooks("DailyBugCount_MASTER.xlsm").Activate
Sheets("ANALYTICS").Select
'Be sure the following range corresponds to the correct department in destination file
For Each c In Range("B9:AM9").Cells
If c = "" Then c.value= 0
End If
Next c

'Analytics - Analysts
Workbooks("SOURCE.xlsx").Activate
With Sheets("Data").Columns(1)
Set rFound = .Find(What:="Analytics - Analysts", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If rFound Is Nothing Then Resume Next
rFound(1, 2).Copy

Workbooks("DailyBugCount_MASTER.xlsm").Activate
Sheets("ANALYTICS").Select
'Be sure the following range corresponds to the correct department in destination file
For Each c In Range("B10:AM10").Cells
If c = "" Then
c.value=0
End If
Next

'Analytics - Engineers
Workbooks("SOURCE.xlsx").Activate
With Sheets("Data").Columns(1)
Set rFound = .Find(What:="Analytics - Engineers", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If rFound Is Nothing Then Resume Next
rFound(1, 2).Copy

Workbooks("DailyBugCount_MASTER.xlsm").Activate
Sheets("ANALYTICS").Select
'Be sure the following range corresponds to the correct department in destination file
For Each c In Range("B11:AM11").Cells
If c = "" Then
c.value = 0
End If
Next

Application.ScreenUpdating = True

End Sub

Need Code Modification

Minerva7

New Member

Excel Facts

Michael M

Well-known Member

Minerva7

New Member

Minerva7

New Member

Michael M

Well-known Member

Similar threads

Forum statistics

Share this page

Need Code Modification

Minerva7

New Member

Excel Facts

Michael M

Well-known Member

Minerva7

New Member

Minerva7

New Member

Michael M

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock