My code need to go on a diet

  • Thread starter Thread starter Vacuum Sealed
  • Start date Start date
V

Vacuum Sealed

Hi All

Hoping everyone had a great holiday season.

For all intensive purposes, the code below looks fat and long-winded yet
works well. That said! I was thinking it could lose a little weight and
run somewhat faster....

I could use Copy/Paste, but I am trying to stay away from it and learn
to do it better

Any assistance is appreciated.


Dim AWS As Worksheet
Dim SWS As Worksheet
Dim Tenders As Range
Dim tVal1 As Range, tVal2 As Range, tVal3 As Range, tVal4 As Range,
tVal5 As Range, tVal6 As Range
Dim tVal7 As Range, tVal8 As Range, tVal9 As Range, tVal10 As Range,
tVal11 As Range, tVal12 As Range
Dim tVal13 As Range, tVal14 As Range, tVal15 As Range, tVal16 As Range,
tVal17 As Range, tVal18 As Range
Dim tVal19 As Range, tVal20 As Range, tVal21 As Range, tVal22 As Range,
tVal23 As Range, tVal24 As Range


Set AWS = ActiveSheet
Set SWS = Worksheets("TMS DATA")
Set Tenders = SWS.Range("N6:N200")
Set tVal1 = [G12]
Set tVal2 = [H12]
Set tVal3 = [I12]
Set tVal4 = [J12]
Set tVal5 = [K12]
Set tVal6 = [L12]
Set tVal7 = [M12]
Set tVal8 = [N12]
Set tVal9 = [O12]
Set tVal10 = [P12]
Set tVal11 = [Q12]
Set tVal12 = [R12]
Set tVal13 = [S12]
Set tVal14 = [T12]
Set tVal15 = [U12]
Set tVal16 = [V12]
Set tVal17 = [W12]
Set tVal18 = [X12]
Set tVal19 = [Y12]
Set tVal20 = [Z12]
Set tVal21 = [AA12]
Set tVal22 = [AB12]
Set tVal23 = [AC12]
Set tVal24 = [AD12]


Range("G13").Select

With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal1)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal2)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal3)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal4)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal5)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal6)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal7)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal8)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal9)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal10)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal11)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal12)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal13)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal14)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal15)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal16)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal17)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal18)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal19)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal20)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal21)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal22)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal23)
.Offset(0, 1).Select
End With
With ActiveCell
.Value = Application.WorksheetFunction.CountIf(Tenders, tVal24)
End With

End Sub

TIA
Mick
 
Try...

Sub GetCount()
' Assumes this code runs on ActiveSheet
Dim Tenders As Range
Dim v As Variant
Const sSearchSource As String =
"G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,AB,AC,AD"
Const lSourceRow& = 12
Set Tenders = Sheets("TMS DATA").Range("N6:N200")
For Each v In Split(sSearchSource, ",")
Range(v & lSourceRow + 1) =
Application.WorksheetFunction.CountIf(Tenders, Range(v & lSourceRow))
Next 'v
End Sub


If you want to use cell formula instead of VBA:

Select G13

Open Define Name dialog

In the name box type
'<sheetname>'!LastCell
..where you need to replace <sheetname> with the actual sheet name.
(Make sure you wrap the sheetname in apostrophes if it has any
characters other than letters, numbers, or the underscore)

In the RefersTo box type
=g12
..and press the Enter key

Select G13:AD13
Type =countif('TMS DATA'!N6:N200,lastcell)
Keyboard Ctrl+Enter to put the formula in all cells at once

HTH
 
Selections for one thing. Something like this should do
don't need "worksheetfunction"
NOT tested


dim tenders as range
dim i as long
Set Tenders = SWS.Range("N6:N200")
for i = 13 to 37
cells("g",i).value= application.CountIf(Tenders, cells(12,i-1))
next i




Hi All

Hoping everyone had a great holiday season.

For all intensive purposes, the code below looks fat and long-winded yet
works well. That said! I was thinking it could lose a little weight and
run somewhat faster....

I could use Copy/Paste, but I am trying to stay away from it and learn
to do it better

Any assistance is appreciated.

Dim AWS As Worksheet
Dim SWS As Worksheet
Dim Tenders As Range
Dim tVal1 As Range, tVal2 As Range, tVal3 As Range, tVal4 As Range,
tVal5 As Range, tVal6 As Range
Dim tVal7 As Range, tVal8 As Range, tVal9 As Range, tVal10 As Range,
tVal11 As Range, tVal12 As Range
Dim tVal13 As Range, tVal14 As Range, tVal15 As Range, tVal16 As Range,
tVal17 As Range, tVal18 As Range
Dim tVal19 As Range, tVal20 As Range, tVal21 As Range, tVal22 As Range,
tVal23 As Range, tVal24 As Range

Set AWS = ActiveSheet
Set SWS = Worksheets("TMS DATA")
Set Tenders = SWS.Range("N6:N200")
Set tVal1 = [G12]
Set tVal2 = [H12]
Set tVal3 = [I12]
Set tVal4 = [J12]
Set tVal5 = [K12]
Set tVal6 = [L12]
Set tVal7 = [M12]
Set tVal8 = [N12]
Set tVal9 = [O12]
Set tVal10 = [P12]
Set tVal11 = [Q12]
Set tVal12 = [R12]
Set tVal13 = [S12]
Set tVal14 = [T12]
Set tVal15 = [U12]
Set tVal16 = [V12]
Set tVal17 = [W12]
Set tVal18 = [X12]
Set tVal19 = [Y12]
Set tVal20 = [Z12]
Set tVal21 = [AA12]
Set tVal22 = [AB12]
Set tVal23 = [AC12]
Set tVal24 = [AD12]

     Range("G13").Select

     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal1)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal2)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal3)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal4)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal5)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal6)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal7)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal8)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal9)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal10)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal11)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal12)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal13)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal14)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal15)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal16)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal17)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal18)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal19)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal20)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal21)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal22)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal23)
         .Offset(0, 1).Select
     End With
     With ActiveCell
         .Value = Application.WorksheetFunction.CountIf(Tenders, tVal24)
     End With

End Sub

TIA
Mick
Click to expand...
 
I was thinking very hard and decided the following should use absolute
reference to the source range:
Select G13:AD13
Click to expand...
Type =countif('TMS DATA'!$N$6:$N$200,lastcell)
Keyboard Ctrl+Enter to put the formula in all cells at once
Click to expand...

Sorry about that...
 
Try...

Sub GetCount()
' Assumes this code runs on ActiveSheet
Dim Tenders As Range
Dim v As Variant
Const sSearchSource As String =
"G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,AB,AC,AD"
Const lSourceRow& = 12
Set Tenders = Sheets("TMS DATA").Range("N6:N200")
For Each v In Split(sSearchSource, ",")
Range(v & lSourceRow + 1) =
Application.WorksheetFunction.CountIf(Tenders, Range(v & lSourceRow))
Next 'v
End Sub


If you want to use cell formula instead of VBA:

Select G13

Open Define Name dialog

In the name box type
'<sheetname>'!LastCell
..where you need to replace <sheetname> with the actual sheet name.
(Make sure you wrap the sheetname in apostrophes if it has any
characters other than letters, numbers, or the underscore)

In the RefersTo box type
=g12
..and press the Enter key

Select G13:AD13
Type =countif('TMS DATA'!N6:N200,lastcell)
Keyboard Ctrl+Enter to put the formula in all cells at once

HTH
Click to expand...

Hi Garry

appreciate the reply

This code halts on "Source" with an error ( Expected: As Or = )

I actually went with Don's code on this occasion.

Thx heaps though, I always look forward to your contributions.

Regards
Mick
 
I was thinking very hard and decided the following should use absolute
reference to the source range:

Type =countif('TMS DATA'!$N$6:$N$200,lastcell)

Sorry about that...
Click to expand...

Garry

As much as I am doing my utmost to move away from nested formula in
favor of VB, I tried this formula although it returned a row of zero's
even with sample data for testing.

Thanks again though

Cheers
Mick.
 
Selections for one thing. Something like this should do
don't need "worksheetfunction"
NOT tested


dim tenders as range
dim i as long
Set Tenders = SWS.Range("N6:N200")
for i = 13 to 37
cells("g",i).value= application.CountIf(Tenders, cells(12,i-1))
next i
Click to expand...

Hey Don

Thanks for this, I had to modify it slightly, but it works a treat.

Dim SWS As Worksheet
Dim Tenders As Range
Dim i As Long
Set SWS = Worksheets("TMS DATA")
Set Tenders = SWS.Range("N6:N200")
For i = 7 To 30
Cells(13, i).Value = Application.CountIf(Tenders, Cells(12, i))
Next i

Thanks again
Mick.
 
Vacuum Sealed was thinking very hard :
Hi Garry

appreciate the reply

This code halts on "Source" with an error ( Expected: As Or = )

I actually went with Don's code on this occasion.

Thx heaps though, I always look forward to your contributions.

Regards
Mick
Click to expand...

Not sure why you're getting the error because I tested the code with
sample data before posted and got the results you wanted without error.
Maybe the copy/paste broke the lines because there is no single word
"Source" in my code.
 
Vacuum Sealed was thinking very hard :
Garry

As much as I am doing my utmost to move away from nested formula in favor of
VB, I tried this formula although it returned a row of zero's even with
sample data for testing.

Thanks again though

Cheers
Mick.
Click to expand...

Mick,
As with my VBA solution, I used this formula on the same test data and
got the same results as the VBA code. Does the cells above the formula
cells (row12) contain any data? Or the correct data?
 
Vacuum Sealed was thinking very hard :

Mick, As with my VBA solution, I used this formula on the same test
data and got the same results as the VBA code. Does the cells above
the formula cells (row12) contain any data? Or the correct data?
Click to expand...


Thx garry

G H I J k ........
12 1 2 3 4 5........
13

Row 12 has the above values in them permanently which correspond to the
value match from the TMS range, and Row 13 has no values at all until
populated by the code.

Cheers
Mick.
 
Vacuum Sealed was thinking very hard :

Not sure why you're getting the error because I tested the code with
sample data before posted and got the results you wanted without error.
Maybe the copy/paste broke the lines because there is no single word
"Source" in my code.
Click to expand...
Actually Garry

Looking at the code again, you are right, it does appear I did clean up
the paste incorrectly.

I will have another flirt with it tomorrow when I superglue my ass to
the work chair...lol...

Thx again
Mick.
 
Back
Top