VBA - Duplicated values after running the loop more than once

M

mysticmario

Active Member
Joined
Nov 10, 2021
Messages
323
Office Version
  1. 365
Platform
  1. Windows
I have this huge block of code, where The date is being found based on userform input, then the empty cell is being found in the same row to add values to it and soem 2 more values to column C and B on the same row.
When i run this and lets say input 22.02.2023 as date to be found I get something like this which is great:

1678190980023.png
but then I run the loop again with different date, and accordingly to what I want - if the employee value and Jobtype value is already there, just update the row with new hours
but for some reason i get the new row with Me.employee.value, Me.JobType.value and Me.HoursCount.value in this example it would be" Janusz", "SK," and "1", but the rest of the values from Jobtype2, jobtype3 and so on are being updated in the same row as I wanted.
1678191236843.png

1678191269892.png

Can you help em spot the issue? Here's the code:
VBA Code: 
'find date'
Sheets(sheetName).Activate
FindDate = CDate(Me.DateRange.Value)
Set dRng = Range("D7:J7,D67:J67,D127:J127,D187:J187,D247:J247,D307:J307,D367:J367,D427:J427,D487:J487,D547:J547,D607:J607")
Dim emptyCellFound As Boolean 'variable to track if an empty cell has been found
emptyCellFound = False

For Each emptyCell In dRng
    If emptyCell.Value2 = CLng(FindDate) Then
        Dim colNum As Integer
        colNum = emptyCell.Column 'get the column number where the date was found
        For b = emptyCell.Row + 1 To emptyCell.Row + 32 'start the loop from the next row of the found date cell
            If Cells(b, colNum).Value = "" Then 'check if the cell is empty in the same column where the date was found
                Set emptyCell = Cells(b, colNum)
                ' Add jobtype and hours
                If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType.Value Then
                emptyCell.Value = Me.HoursCount.Value
                Else
                emptyCell.Value = Me.HoursCount.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
            End If
        Next b
    
    End If
    
    If emptyCellFound Then 'exit the outer loop if an empty cell has been found
        Exit For
    End If
Next emptyCell

If Not emptyCellFound Then 'check if an empty cell was found
    MsgBox "No empty cell available below " & dRng.Address
    Exit Sub
End If
    ' Find next empty cell for JobType2 and HoursCount2
If Len(Me.JobType2.Value) > 0 And Len(Me.HoursCount2.Value) > 0 Then
    emptyCellFound = False 'reset the flag
    For Each emptyCell In dRng
        If emptyCell.Value2 = CLng(FindDate) Then
            colNum = emptyCell.Column 'get the column number where the date was found
            For b = emptyCell.Row + 1 To emptyCell.Row + 32
                If Cells(b, colNum).Value = "" Then
                    Set emptyCell = Cells(b, colNum)
                    ' Add jobtype and hours
                    If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType2.Value Then
                emptyCell.Value = Me.HoursCount2.Value
                Else
                emptyCell.Value = Me.HoursCount2.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType2.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
            End If
        Next b
        End If
        
        If emptyCellFound Then 'exit the loop if an empty cell has been found
            Exit For
        End If
    Next emptyCell
    
    If Not emptyCellFound Then 'check if an empty cell was found
        MsgBox "No empty cell available below " & dRng.Address
        Exit Sub
    End If
End If
    'find next emoty cell for JobType3 and HoursCount3
If Len(Me.JobType3.Value) > 0 And Len(Me.HoursCount3.Value) > 0 Then
    emptyCellFound = False 'reset the flag
    For Each emptyCell In dRng
        If emptyCell.Value2 = CLng(FindDate) Then
            colNum = emptyCell.Column 'get the column number where the date was found
            For b = emptyCell.Row + 1 To emptyCell.Row + 32
                If Cells(b, colNum).Value = "" Then
                    Set emptyCell = Cells(b, colNum)
                    ' Add jobtype and hours
                    If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType3.Value Then
                emptyCell.Value = Me.HoursCount3.Value
                Else
                emptyCell.Value = Me.HoursCount3.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType3.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
            End If
        Next b
        End If
        
        If emptyCellFound Then 'exit the loop if an empty cell has been found
            Exit For
        End If
    Next emptyCell
    
    If Not emptyCellFound Then 'check if an empty cell was found
        MsgBox "No empty cell available below " & dRng.Address
        Exit Sub
    End If
End If
    'find next emoty cell for JobType4 and HoursCount4
If Len(Me.JobType4.Value) > 0 And Len(Me.HoursCount4.Value) > 0 Then
    emptyCellFound = False 'reset the flag
    For Each emptyCell In dRng
        If emptyCell.Value2 = CLng(FindDate) Then
            colNum = emptyCell.Column 'get the column number where the date was found
            For b = emptyCell.Row + 1 To emptyCell.Row + 32
                If Cells(b, colNum).Value = "" Then
                    Set emptyCell = Cells(b, colNum)
                    ' Add jobtype and hours
                    If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType4.Value Then
                emptyCell.Value = Me.HoursCount4.Value
                Else
                emptyCell.Value = Me.HoursCount4.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType4.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
            End If
        Next b
        End If
        
        If emptyCellFound Then 'exit the loop if an empty cell has been found
            Exit For
        End If
    Next emptyCell
    
    If Not emptyCellFound Then 'check if an empty cell was found
        MsgBox "No empty cell available below " & dRng.Address
        Exit Sub
    End If
End If
    'find next emoty cell for JobType5 and HoursCount5
If Len(Me.JobType5.Value) > 0 And Len(Me.HoursCount5.Value) > 0 Then
    emptyCellFound = False 'reset the flag
    For Each emptyCell In dRng
        If emptyCell.Value2 = CLng(FindDate) Then
            colNum = emptyCell.Column 'get the column number where the date was found
            For b = emptyCell.Row + 1 To emptyCell.Row + 32
                If Cells(b, colNum).Value = "" Then
                    Set emptyCell = Cells(b, colNum)
                    ' Add jobtype and hours
                    emptyCell.Value = Me.HoursCount2.Value
                    If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType5.Value Then
                emptyCell.Value = Me.HoursCount5.Value
                Else
                emptyCell.Value = Me.HoursCount5.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType5.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
            End If
        Next b
        End If
        
        If emptyCellFound Then 'exit the loop if an empty cell has been found
            Exit For
        End If
    Next emptyCell
    
    If Not emptyCellFound Then 'check if an empty cell was found
        MsgBox "No empty cell available below " & dRng.Address
        Exit Sub
    End If
End If
    'find next emoty cell for JobType6 and HoursCount6
If Len(Me.JobType6.Value) > 0 And Len(Me.HoursCount6.Value) > 0 Then
    emptyCellFound = False 'reset the flag
    For Each emptyCell In dRng
        If emptyCell.Value2 = CLng(FindDate) Then
            colNum = emptyCell.Column 'get the column number where the date was found
            For b = emptyCell.Row + 1 To emptyCell.Row + 32
                If Cells(b, colNum).Value = "" Then
                    Set emptyCell = Cells(b, colNum)
                    ' Add jobtype and hours
                    If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType6.Value Then
                emptyCell.Value = Me.HoursCount6.Value
                Else
                emptyCell.Value = Me.HoursCount6.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType6.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
            End If
        Next b
        End If
        
        If emptyCellFound Then 'exit the loop if an empty cell has been found
            Exit For
        End If
    Next emptyCell
    
    If Not emptyCellFound Then 'check if an empty cell was found
        MsgBox "No empty cell available below " & dRng.Address
        Exit Sub
    End If
End If
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Sort by date Sort by votes
All the code makes sense to me, I just dont know why the first jobtype and hourscount is duplicated If have the if statement to prevent it .
 
Upvote 0
It seems a big project, with userform, and many sheets.
How we can test, without a sample file.
Could you share file via gg drive, or dropbox... do not forget to delete sensitive data
 
Upvote 0
bebo021999 said:
It seems a big project, with userform, and many sheets.
How we can test, without a sample file.
Could you share file via gg drive, or dropbox... do not forget to delete sensitive data
Click to expand...
At the moemnt big would be a little understatement what started as a simple few macros to speed things up evolved over the year, now it's 10mb in size with tousands of macros, but the issue is it interacts with ondedrive google drive and webbrowser, so it's hard to share with people withotu them having issues runnign it with all the dependecies I have. Also the entire thing is mostly written in Polish. If you can run it you would still need a lot of guidance to navigate it. If you have the patience i'm down.
 
Upvote 0
I made the link inactive, if someone wants access let me know I will reinstate it.
 
Upvote 0
Alright i see the issue but I dont know how to actually fix it. When I run the loop once all the data is addded to the **** normaly, btu when i run ti again the code runs this first:
VBA Code: 
                If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType.Value Then
                emptyCell.Value = Me.HoursCount.Value
And then instead of moving on to the loop for jobtype2 and hourscount2, It runs the loop again btu this time goes for:
VBA Code: 
Else
                emptyCell.Value = Me.HoursCount6.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType6.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
so it executes both parts of the loop resaulting in duplicated row of values in this loop.I have to be missign so small bit.
 
Upvote 0
Changed this:
VBA Code: 
 If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType.Value Then
                emptyCell.Value = Me.HoursCount.Value
                Else
                emptyCell.Value = Me.HoursCount.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
to this:

VBA Code: 
 If Cells(emptyCell.Row, "B").Value = Me.employee.Value And Cells(emptyCell.Row, "C").Value = Me.JobType.Value Then
                emptyCell.Value = Me.HoursCount.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                Else
                emptyCell.Value = Me.HoursCount.Value
                Cells(emptyCell.Row, "C").Value = Me.JobType.Value
                Cells(emptyCell.Row, "B").Value = Me.employee.Value
                emptyCellFound = True 'set the flag to indicate that an empty cell has been found
                Exit For
                End If
and it's now fine. Obvious details, but i somehow missed that.
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

M
  • Solved
VBA Modyfing loop to create a new line on specific conditions
Replies
7
Views
663
dmt32
D
M
  • Solved
VBA code for finding date sometimes doesn't work.
3 4 5
Replies
41
Views
4K
mysticmario
M
M
  • Question Question
Finding value of textbox in specified range or ranges
Replies
4
Views
426
mysticmario
M
I
  • Question Question
Unable to run VBA code
Replies
6
Views
165
RoryA
RoryA
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
118
RoryA
RoryA

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top