PDA

View Full Version : [SOLVED] Outcome is not as expected - code might be wrong



ell_
01-22-2018, 08:02 AM
Hi, all

I have tried to create a code which can be seen below:


Sub Test()
Dim rw As Long, x As Long, lr As Long, r As Long, g As Long
lr = Sheets("DTE").Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To lr
If Sheets("DTE").Cells(x, 1) = Sheets("DTE").Range("K2") Then rw = rw + 1
If rw = 6 Then 'to determine dimension
Dim cel As Range
Dim Width As Double
Dim Height As Double
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Height = Height + cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Width = Width + cel.Width
Next cel
With Sheets("Definitions") 'to fill in table in Definitions based on 3 table(s) DTE sheet - number of tables might change, based on data available
g = 16
If IsEmpty(.Cells(x, 1)) = True Then
.Cells(x, 1) = "DTE"
.Cells(x, 2) = A" & (rw - 5) & ":" & "G" & rw 'might be wrong
.Cells(x, 3) = "Range"
.Cells(x, 4) = g + 1 'wrong?
.Cells(x, 5) = "Table"
.Cells(x, 6) = "1.50"
.Cells(x, 7) = "0.5"
.Cells(x, 8) = Round(Height / 72, 2)
.Cells(x, 9) = Round(Width / 72, 2) 'both dimensions are wrong

End If
End With
rw = 0
End If
Next
End Sub



But, my outcome became like this:

21424

Instead of this (my target):

21425

The height and width in my target are based on a program I found online which can determine the dimension of selected cell range. Hereby I attached the Excel file as well.

Not sure which part of the code that I did wrong. Hoping for your enlightenment. Thanks in advance!

paulked
01-22-2018, 08:42 AM
You are using the row index (x) from the DTE sheet, the code below adds 'row by row' to the Definitions sheet.



Sub Test()
Dim rw As Long, x As Long, lr As Long, r As Long, g As Long
lr = Sheets("DTE").Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To lr
If Sheets("DTE").Cells(x, 1) = Sheets("DTE").Range("K2") Then rw = rw + 1
If rw = 6 Then
Dim cel As Range
Dim Width As Double
Dim Height As Double
Dim lrD As Long
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Height = Height + cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Width = Width + cel.Width
Next cel
With Sheets("Definitions")
lrD = .Cells(Rows.Count, 1).End(xlUp).Row + 1
g = 16
If IsEmpty(.Cells(x, 1)) = True Then
.Cells(lrD, 1) = "DTE"
.Cells(lrD, 2) = "A" & (rw - 5) & ":" & "G" & rw
.Cells(lrD, 3) = "Range"
.Cells(lrD, 4) = g + 1
.Cells(lrD, 5) = "Table"
.Cells(lrD, 6) = "1.50"
.Cells(lrD, 7) = "0.5"
.Cells(lrD, 8) = Round(Height / 72, 2)
.Cells(lrD, 9) = Round(Width / 72, 2)
End If
End With
rw = 0
End If
Next
End Sub

paulked
01-22-2018, 08:46 AM
I don't get the g =16, then the .Cells(lrD, 4) = g + 1. Why not .Cells(lrD, 4) = 17?

If you want to increment g then g=16 needs to be moved out of the loop.

ell_
01-22-2018, 09:15 AM
Yes I actually want an increment but I'm just not sure where to put the g=16. Hence, I should put before With?

paulked
01-22-2018, 09:32 AM
No, put it before



For x = 1 to lr

ell_
01-22-2018, 05:09 PM
Hi, Paulked

I have tried the code but the loop to update the table in Definitions sheet are not repeating. Here's the outcome:
21433
I believe there's something wrong with the loop and the dimensions part? Here's my full code finalized:


Sub Test()
Dim rw As Long, x As Long, lr As Long, r As Long, g As Long
lr = Sheets("DTE").Cells(Rows.Count, 1).End(xlUp).Row
g = 16
For x = 1 To lr
If Sheets("DTE").Cells(x, 1) = Sheets("DTE").Range("K2") Then rw = rw + 1 'I believe the condition should be altered to something else but not sure what condition should be put here
If rw = 6 Then
Dim cel As Range
Dim Width As Double
Dim Height As Double
Dim lrD As Long
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Height = Height + cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Width = Width + cel.Width
Next cel
With Sheets("Definitions")
lrD = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If IsEmpty(.Cells(x, 1)) = True Then 'this part is to detect blank row of Table in Definitions sheet so should I define new parameter?
.Cells(lrD, 1) = "DTE"
.Cells(lrD, 2) = "A" & (rw - 5) & ":" & "G" & rw 'I believe I interpret this part wrong too, it should record the cell range of each table in DTE sheet
.Cells(lrD, 3) = "Range"
.Cells(lrD, 4) = g + 1 'not increasing
.Cells(lrD, 5) = "Table"
.Cells(lrD, 6) = "1.50"
.Cells(lrD, 7) = "0.5"
.Cells(lrD, 8) = Round(Height / 72, 2) 'way too big in number for both height and width
.Cells(lrD, 9) = Round(Width / 72, 2)
End If
End With
rw = 0
End If
Next
End Sub



The tricky parts here are probably to record the cell ranges of table as per shown in outcome under column B, the increment of g+1 and the height and width of each table in which I'm still stuck with :dunno

paulked
01-22-2018, 07:42 PM
I've had a closer look at your code and the set-up of your worksheet. It's a bit of a muddle, to say the least!


I believe the condition should be altered to something else but not sure what condition should be put here

I'm afraid I can't think for you, it has to be some condition and the one you've got is quite a good starting point.


this part is to detect blank row of Table in Definitions sheet so should I define new parameter?

You are writing to the first blank row with the Row + 1 on the line above.


I believe I interpret this part wrong too, it should record the cell range of each table in DTE sheet

The rw should be the row number of the DTE sheets, not the count value, change it to x


not increasing

I've no idea where this figure comes from, but if you want it to start at 17 then increment by 1 each time, we add g = g + 1 after it has filled the cell. But the next time you run the sub (on another selection in K2 for instance) then it will start from 17 again.


way too big in number for both height and width

Yes, these can only get bigger as you are adding them together each time the sub loops. Not sure what you want, but Height = cel.Height and Width = cel.Width is another starting point.

Try this:



Sub Test()
Dim rw As Long, x As Long, lr As Long, r As Long, g As Long
lr = Sheets("DTE").Cells(Rows.Count, 1).End(xlUp).Row
g = 17
For x = 1 To lr
If Sheets("DTE").Cells(x, 1) = Sheets("DTE").Range("K2") Then rw = rw + 1
If rw = 6 Then
Dim cel As Range
Dim Width As Double
Dim Height As Double
Dim lrD As Long
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Height = cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Width = cel.Width
Next cel
With Sheets("Definitions")
lrD = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If IsEmpty(.Cells(x, 1)) = True Then
.Cells(lrD, 1) = "DTE"
.Cells(lrD, 2) = "A" & (x - 5) & ":" & "G" & x
.Cells(lrD, 3) = "Range"
.Cells(lrD, 4) = g
g = g + 1
.Cells(lrD, 5) = "Table"
.Cells(lrD, 6) = "1.50"
.Cells(lrD, 7) = "0.5"
.Cells(lrD, 8) = Round(Height / 72, 2)
.Cells(lrD, 9) = Round(Width / 72, 2)
End If
End With
rw = 1
End If
Next
End Sub

paulked
01-22-2018, 08:10 PM
I have just been told that I sounded a bit mean with my first comment.

I would like to assure you it was in no way, shape or form, meant to be a slur, it is just my pathetic attempt at humour at 02:45... Really tired, but can't sleep!

ell_
01-22-2018, 08:28 PM
Can I know why rw is changed to 1 at the bottom?
rw = 1

P/s: no, not mean at all. I understand. Really appreciate the time you spent to go through my materials.

paulked
01-22-2018, 08:38 PM
Once it has counted to 6 it needs to be reset, you could be correct in that it may need to be changed to rw = 0

paulked
01-22-2018, 08:46 PM
Can I ask what you are trying to achieve her:



For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Height = cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Width = cel.Width
Next cel


It was Height = Height + cel.Height before I changed it.

ell_
01-22-2018, 08:50 PM
Noted on that, I have corrected the code yet only A1:G6 is not recorded. Although my condition is wrong (rw =6 hence A13:G14 will be excluded based on my understanding), yet the code is supposed to run for cell A7:G12 since it follows the rule of rw = 6 right?

ell_
01-22-2018, 08:54 PM
Can I ask what you are trying to achieve her:



For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Height = cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Width = cel.Width
Next cel



From my understanding (which I am pretty lacking in VBA, my apology I am really new in this), following my old code, it was supposed to detect every single height and width of cells in the range and adds it up.

paulked
01-22-2018, 09:00 PM
Yes, rw = 1 is correct, but it also has to be set at the beginning of the sub, like here:



Dim rw As Long, x As Long, lr As Long, r As Long, g As Long
lr = Sheets("DTE").Cells(Rows.Count, 1).End(xlUp).Row
g = 17
rw = 1
For x = 1 To lr

paulked
01-22-2018, 09:02 PM
I'll look at the height now.

paulked
01-22-2018, 09:05 PM
Change:



If rw = 6 Then
Dim cel As Range
Dim Width As Double
Dim Height As Double
Dim lrD As Long
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Height = cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Width = cel.Width
Next cel
With Sheets("Definitions")


to:



If rw = 6 Then
Dim cel As Range
Dim Width As Double
Dim Height As Double
Dim lrD As Long
Height = 0
Width = 0
For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw)
Height = Height + cel.Height
Width = Width + cel.Width
Next cel
With Sheets("Definitions")

ell_
01-22-2018, 09:18 PM
This new code works well with some alterations! Thanks for your effort!

Now, I have to configure how can I change the condition on top. What if I change


rw = 6

to


rw > 0

since I want to add the third table as well (A13:G14)? But all the range of

("A" & (rw - 5) & ":" & "G" & rw)

have to change too right?

Update: should I use array? Array sounds reasonable but I have totally no idea with array that is why I only manage to use if conditions :banghead:

paulked
01-22-2018, 09:36 PM
Yes, the code needs to be re-written as this can't easily be adapted to do that.

It would be easier to complete the range with "Natz" up to the end of that section when you fill the DTE sheet.

21434

paulked
01-22-2018, 09:51 PM
Sorry, the height and width are wrong, it needs to be done with:



For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "A" & rw)
Height = Height + cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw) & ":" & "G" & rw)
Width = Width + cel.Width
Next cel

ell_
01-22-2018, 09:54 PM
Yes, the code needs to be re-written as this can't easily be adapted to do that.

It would be easier to complete the range with "Natz" up to the end of that section when you fill the DTE sheet.

21434

Actually the number of data would change per month, but as per confirmed by my superior, it will limit up to 15 data per month. That is why the recorded data here is less than 15, so that the code altered or edited here may accommodate the amount of data.

Is it possible if we use SPLIT to split the rows whenever we found the one copied header and then we count rows for which cells that are not blank? And after that, the program will loop again but this time, the count will adds up to give the right range?

ell_
01-22-2018, 09:56 PM
Sorry, the height and width are wrong, it needs to be done with:



For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "A" & rw)
Height = Height + cel.Height
Next cel
For Each cel In Sheets("DTE").Range("A" & (rw) & ":" & "G" & rw)
Width = Width + cel.Width
Next cel


Ahh I see. I have added
.Columns(1) to Height and
.Rows(1) to Width and this follows what I expected.

paulked
01-22-2018, 10:11 PM
You need to write a flow chart or similar to map out exactly what your requirements are, if you know them. That way it lessens the chance of hitting another 'dead end'.

I've got to go now, work beckons and it's gone 5am with no sleep! Hope you make some progress and catch up soon.

Cheers

Paul Ked

ell_
01-22-2018, 10:20 PM
Thanks, Paul for your effort. I really appreciate it. Have a nice day :)

P/s: I ticked this thread as solved since I have gotten pretty much 90% of what I want