Macro not functioning properly

Hi Experts,

I would like to request Experts help. The attached script by right should update data from column J from Daily Tracking List sheet to Chart 2 sheet based on data that was updated at cell B41 (week of the month). However, for some reason the macro not extracting data from Daily Tracking Sheet at column B43 onwards. Hope Experts will help me to fix this error.



Sub InsertIssue()

   Dim mRow As Long
   Dim mstart_date As Date
   Dim mend_date As Date
   Dim rng As Range
   Dim varMatch
   Dim wks As Worksheet, wksOut As Worksheet
   mRow = 43

   Set wks = Sheets("Chart")
   Set wksOut = Sheets("Chart2")
   'Clear Issue Columns
   wksOut.Cells(mRow, "B").Resize(5, 19).ClearContents
   With wks

      'Search Start and end date
      varMatch = Application.Match(wksOut.Range("B41").Value, .Range("A2:A54"), 0)
      If Not IsError(varMatch) Then
         mstart_date = .Cells(varMatch, "B").Value
         mend_date = .Cells(varMatch, "C").Value
      End If

      'Write Issue
      Set rng = Sheets("Daily Tracking List").Range("B2")
      Do Until rng.Value = ""
         If rng.Value >= mstart_date And rng.Value <= mend_date And _
            rng.Offset(0, 2).Value = .Range("R1").Value And _
            Trim(LCase(rng.Offset(0, 7).Value)) = "yes" Then
            wksOut.Cells(mRow, 2).Value = rng.Offset(0, 8).Value
            mRow = mRow + 1
         End If
         Set rng = rng.Offset(1, 0)
      Loop
   End With
   'If No Issue
   If mRow = 43 Then
      wksOut.Cells(mRow, 2).Value = "No Issue"
   End If
End Sub

Open in new window

Chart-V5.xls
CartilloAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

SiddharthRoutCommented:
There is nothing technically wrong with the code.

The values of mstart_date and mend_date are 3/21/2011 and 3/27/2011 respectively. If you check Sheets "Daily Tracking List", there is no date which falls between those dates and hence your IF condition is not true in the Do Loop. That is why you are not getting any records :)

Sid
0
SiddharthRoutCommented:
To make it work

Change this line

varMatch = Application.Match(Trim(wksOut.Range("B41").Value), .Range("A2:A54"), 0)

to

varMatch = Application.Match(Trim(wksOut.Range("B41").Value), .Range("A2:A54"), 0) + 1

Sid
0
SiddharthRoutCommented:
Tested and Tried

One more change. In the If condition you are matching it with R1. I guess it should be S1

Try this code. I tested it and it works.

Sub InsertIssue()
   Dim mRow As Long, varMatch As Long
   Dim mstart_date As Date, mend_date As Date
   Dim rng As Range
   Dim wks As Worksheet, wksOut As Worksheet
   mRow = 43

   Set wks = Sheets("Chart")
   Set wksOut = Sheets("Chart2")
   'Clear Issue Columns
   wksOut.Cells(mRow, "B").Resize(5, 19).ClearContents
   With wks
      'Search Start and end date
      varMatch = Application.Match(Trim(wksOut.Range("B41").Value), .Range("A1:A54"), 0)
      If Not IsError(varMatch) Then
         mstart_date = .Cells(varMatch, "B").Value
         mend_date = .Cells(varMatch, "C").Value
      End If
      'Write Issue
      Set rng = Sheets("Daily Tracking List").Range("B2")
      Do Until rng.Value = ""
         If rng.Value >= mstart_date And rng.Value <= mend_date And _
            rng.Offset(0, 2).Value = .Range("S1").Value And _
            Trim(LCase(rng.Offset(0, 7).Value)) = "yes" Then
            wksOut.Cells(mRow, 2).Value = rng.Offset(0, 8).Value
            mRow = mRow + 1
         End If
         Set rng = rng.Offset(1, 0)
      Loop
   End With
   'If No Issue
   If mRow = 43 Then
      wksOut.Cells(mRow, 2).Value = "No Issue"
   End If
End Sub

Open in new window


Sid
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Learn SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

CartilloAuthor Commented:
Hi Sid,

Thanks for the feedback. Have tested by changing the line but the problem still persist. By right the code should looking at cell B41(Chart2), the cell referring to Week-9, therefore the date range is 28-march to 4-april. There are data at Tracking Master List within this date range under with “Yes” at column I.

The whole issue happen after I changing the target of the chart from Chart sheet to Chart2 sheet. I have attached my original workbook for your kind perusal.

Chart-Ori.xls
0
SiddharthRoutCommented:
Seems like we both pasted at the same time :)

Check my last post :)

Sid
0
CartilloAuthor Commented:
Hi Sid,

It works now with your revised code. Thanks a lot. I need your help. Currently the cell at E39 show error as “#N/A”. How to fix this?
0
SiddharthRoutCommented:
Is the formula correct?

If yes then replace that formula with this

=IF(ISERROR(INDEX(Chart!D2:P54,ROUNDDOWN((TODAY()-Chart!C2+6)/7,0),MATCH(Chart!R1,Chart!D1:P1,0))),"-",INDEX(Chart!D2:P54,ROUNDDOWN((TODAY()-Chart!C2+6)/7,0),MATCH(Chart!R1,Chart!D1:P1,0)))

Sid
0
CartilloAuthor Commented:
Hi,

It shows "-".
0
SiddharthRoutCommented:
Yes If there is an error, I am telling the formula to show "-". If you want to show a blank cell then use this

=IF(ISERROR(INDEX(Chart!D2:P54,ROUNDDOWN((TODAY()-Chart!C2+6)/7,0),MATCH(Chart!R1,Chart!D1:P1,0))),"",INDEX(Chart!D2:P54,ROUNDDOWN((TODAY()-Chart!C2+6)/7,0),MATCH(Chart!R1,Chart!D1:P1,0)))

Sid
0
CartilloAuthor Commented:
Thanks a lot Sid for fixing this error.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.