Missing value, trying to find problem source in the code not written by me.

M

mysticmario

Active Member
Joined
Nov 10, 2021
Messages
323
Office Version
  1. 365
Platform
  1. Windows
Hi there,
I have 2 excel sheets one copies value to the other based on if qty has been given or not.

I am at the finish line and i asked someone to help me to code snippet of code, which allows smooth transition to collumn J if item count on sheet reaches B30. (sheet 2)
Long story short the code has inherited problem where it skips the one item which should be first positions in collumn J. Person who wrote the code either intentionaly or not coded that and in order to fix it he demands money, despite telling me previously he would help me with it free of charge out, because he likes to help...
Now I am stuck with a problem that I did not create myself and his code is not my level so I can't find the source of the problem. Can you help me find the problem?
(providing code and screenshots below)

Here's the code:
VBA Code: 
Sub export_acc()
    Dim Rng As Range, cell As Range, lr As Long, i&, J&
    Set Rng = ActiveSheet.Range("H193:H271")
    If Sheets("KARTA REALIZACJI").Range("B30").Value = Empty Then
        lr = Sheets("KARTA REALIZACJI").Range("B31").End(3).Row
        J = 2
    Else
        lr = 30
        J = J + 9
    End If
    J = 2
    For Each cell In Rng
        If Not IsEmpty(cell) And cell.Value <> 0 Then
            lr = lr + 1
            If lr <= 30 Then
                Sheets("KARTA REALIZACJI").Cells(lr, J).Value = ActiveSheet.Range("D" & cell.Row).Value & " " & ActiveSheet.Range("E" & cell.Row).Value
                Sheets("KARTA REALIZACJI").Cells(lr, J + 1).Value = cell.Value
            Else
                J = J + 9
                lr = 10
            End If
        End If
    Next cell
End Sub
And some screenshots for refference.

3.png2.png4.png5.png

Thank you in advance for your assitance.
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
Hi,
untested & just a guess but see if this update to your code resolves your issue

VBA Code: 
Sub export_acc()
    Dim Rng                 As Range, cell As Range
    Dim lr                  As Long, i As Long, J As Long
    Dim wsKARTA_REALIZACJI   As Worksheet
    
    Set wsKARTA_REALIZACJI = ThisWorkbook.Worksheets("KARTA REALIZACJI")
    
    Set Rng = ActiveSheet.Range("H193:H271")
    
    With wsKARTA_REALIZACJI
    
        If .Range("B30").Value = Empty Then
            lr = .Range("B31").End(xlUp).Row
            J = 2
        Else
            lr = 30
            J = J + 9
        End If
        
    End With
    
    J = 2
    
    For Each cell In Rng
        If Not IsEmpty(cell) And cell.Value <> 0 Then
            
            If lr <= 30 Then
                With wsKARTA_REALIZACJI
                
                    .Cells(lr, J).Value = ActiveSheet.Range("D" & cell.Row).Value & " " & _
                               ActiveSheet.Range("E" & cell.Row).Value
                    .Cells(lr, J + 1).Value = cell.Value
                    
                End With
            Else
                J = J + 9
                lr = 10
            End If
            
            lr = lr + 1
            
        End If
    Next cell
End Sub

if not, perhaps another here can assist as I am off out for the day


Dave
 
Upvote 0
dmt32 said:
Hi,
untested & just a guess but see if this update to your code resolves your issue

VBA Code: 
Sub export_acc()
    Dim Rng                 As Range, cell As Range
    Dim lr                  As Long, i As Long, J As Long
    Dim wsKARTA_REALIZACJI   As Worksheet
   
    Set wsKARTA_REALIZACJI = ThisWorkbook.Worksheets("KARTA REALIZACJI")
   
    Set Rng = ActiveSheet.Range("H193:H271")
   
    With wsKARTA_REALIZACJI
   
        If .Range("B30").Value = Empty Then
            lr = .Range("B31").End(xlUp).Row
            J = 2
        Else
            lr = 30
            J = J + 9
        End If
       
    End With
   
    J = 2
   
    For Each cell In Rng
        If Not IsEmpty(cell) And cell.Value <> 0 Then
           
            If lr <= 30 Then
                With wsKARTA_REALIZACJI
               
                    .Cells(lr, J).Value = ActiveSheet.Range("D" & cell.Row).Value & " " & _
                               ActiveSheet.Range("E" & cell.Row).Value
                    .Cells(lr, J + 1).Value = cell.Value
                   
                End With
            Else
                J = J + 9
                lr = 10
            End If
           
            lr = lr + 1
           
        End If
    Next cell
End Sub

if not, perhaps another here can assist as I am off out for the day


Dave
Click to expand...
the code exprted 31 instead 19 lines, some of them were simply duplicated
 

Attachments

  • 1655890098011.png
    1655890098011.png
    197.9 KB · Views: 6
Upvote 0
dmt32 said:
poor guess then

If can use MrExcel Addin XL2BB - Excel Range to BBCode
To post copy of your worksheets (with dummy data if required) this will allow forum to test suggested changes to your code

Dave
Click to expand...
I woudl love to pull those sheet from the whole excel to provide you for work, howevre my excel has around 200+ sheets, and even I I copy those 2 sheets used for thta task, the code will be lost somewhere in modules of the source file.
dmt32 said:
Hi,
untested & just a guess but see if this update to your code resolves your issue

VBA Code: 
Sub export_acc()
    Dim Rng                 As Range, cell As Range
    Dim lr                  As Long, i As Long, J As Long
    Dim wsKARTA_REALIZACJI   As Worksheet
  
    Set wsKARTA_REALIZACJI = ThisWorkbook.Worksheets("KARTA REALIZACJI")
  
    Set Rng = ActiveSheet.Range("H193:H271")
  
    With wsKARTA_REALIZACJI
  
        If .Range("B30").Value = Empty Then
            lr = .Range("B31").End(xlUp).Row
            J = 2
        Else
            lr = 30
            J = J + 9
        End If
      
    End With
  
    J = 2
  
    For Each cell In Rng
        If Not IsEmpty(cell) And cell.Value <> 0 Then
          
            If lr <= 30 Then
                With wsKARTA_REALIZACJI
              
                    .Cells(lr, J).Value = ActiveSheet.Range("D" & cell.Row).Value & " " & _
                               ActiveSheet.Range("E" & cell.Row).Value
                    .Cells(lr, J + 1).Value = cell.Value
                  
                End With
            Else
                J = J + 9
                lr = 10
            End If
          
            lr = lr + 1
          
        End If
    Next cell
End Sub

if not, perhaps another here can assist as I am off out for the day


Dave
Click to expand...
Somehow after I restarted my excel, the code works perfectly fine...
now I need to apply the same thing if column J also reaches 30 items, the last items should go to column T, after that I'm good with the data transfer.

However thank you for your assitance you've been a great help.

Edit@ and I jumped the gun to hastly. When i changed some of the values imported and the ammoutn of items, the problem happens again. I restarted the excel and executed the sub, looks like pos. no 31 is being skipped and item 32 jumps in it's spot.
 
Last edited:
Upvote 0
Myabe tackle this from the other side, I am willing to drop the idea of taking items apart to seperate columns,
However in order to do that I need to make depedency between 2 subs.
This code import from 2 to 8 items into teh spreadsheet:
VBA Code: 
Sub export_click()
Dim Rng As Range, cell As Range, lr As Long, i&, J&, mtr As Range
    lr = 10
    Set mtr = ActiveSheet.Range("E17, E50, E83, E116, E149")
    Set Rng = ActiveSheet.Range("H193:H271")
    For Each cell In mtr
        If Not IsEmpty(cell) And cell.Value <> 0 Then
            lr = lr + 1
           
            Sheets("KARTA REALIZACJI").Cells(lr, "B").Value = ("Płyta " & cell.Value)
            Sheets("KARTA REALIZACJI").Cells(lr, "C").Value = cell.Offset(20, 1).Value
            lr = lr + 1
            If cell.Offset(20, 4).Value > 0 Then
            Sheets("KARTA REALIZACJI").Cells(lr, "B").Value = ("Obrzeże " & cell.Value)
            Sheets("KARTA REALIZACJI").Cells(lr, "C").Value = cell.Offset(20, 4).Value
            Else:
                lr = lr - 1
                GoTo nextcell
               
            End If
        End If
nextcell:     Next cell
    Call export_acc
    End Sub

And this code: gets the rest of the items, but as you can see the lr is set to be static 10, which basically means it will fill the list from range B11, I need this code below to have
lr= current ummount of items already in range B11:B70
So the code fills the list with items startign from the last not empty cell.
VBA Code: 
Sub export_acc()
    Dim Rng As Range, cell As Range, lr As Long
    Set Rng = ActiveSheet.Range("H193:H271")
    lr = 10
    For Each cell In Rng
        If Not IsEmpty(cell) And cell.Value <> 0 Then
            lr = lr + 1
            Sheets("KARTA REALIZACJI").Cells(lr, "B").Value = ActiveSheet.Range("D" & cell.Row).Value & " " & ActiveSheet.Range("E" & cell.Row).Value
            Sheets("KARTA REALIZACJI").Cells(lr, "C").Value = cell.Value
        End If
    Next cell
End Sub
I tried
lr= Application.CountA(Worksheets("KARTA REALIZACJI").Range("B11:B70"))'
and
lr=Sheets("KARTA REALIZACJI").Cells(Rows.Count, "B").End(xlUp).Row

No success
 
Last edited:
Upvote 0
We can also merge these 2 subs into one I just foudn it easier to seperate them into 2 subs
 
Upvote 0
@mysticmario Try it
VBA Code: 
Option Explicit

Sub export_acc()
    Dim Rng As Range, cell As Range, lr As Long, i&, J&
    Set Rng = ActiveSheet.Range("H193:H271")
    If Sheets("KARTA REALIZACJI").Range("B30").Value = Empty Then
        lr = Sheets("KARTA REALIZACJI").Range("B31").End(3).Row
        J = 2
    Else
        lr = 30
        J = J + 9
    End If
    J = 2
    For Each cell In Rng
        If Not IsEmpty(cell) And cell.Value <> 0 Then
            lr = lr + 1
            If lr < 31 Then
                Sheets("KARTA REALIZACJI").Cells(lr, J).Value = ActiveSheet.Range("D" & cell.Row).Value & " " & ActiveSheet.Range("E" & cell.Row).Value
                Sheets("KARTA REALIZACJI").Cells(lr, J + 1).Value = cell.Value
            Else
                J = J + 9
                lr = lr - 20
                Sheets("KARTA REALIZACJI").Cells(lr, J).Value = ActiveSheet.Range("D" & cell.Row).Value & " " & ActiveSheet.Range("E" & cell.Row).Value
                Sheets("KARTA REALIZACJI").Cells(lr, J + 1).Value = cell.Value
            End If
        End If
    Next cell
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Find and replace multiple values with other values in a range
Replies
8
Views
456
Rick Rothstein
Rick Rothstein
M
  • Solved
Sub does not work using button but runs from VisualBasic window just fine
2 3
Replies
29
Views
2K
mysticmario
M
M
  • Solved
Why vbYesNo doesnt exit sub when requested
Replies
4
Views
458
dmt32
D
M
  • Solved
Copy items from sheet1.range(X:X) to next empty cell in range located in Sheet2.
Replies
3
Views
568
kokano90
K
P
  • Question Question
putting a snippet of code from one to another somehow
Replies
5
Views
322
Patriot2879
P

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

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