Posts by ks0ks

Re: Check if value already exists and if does skip it, don't copy cells

Do you have a sample file that I can work on?

Re: Use VBA to sum the values in named ranged

Thanks Smallman and Tony for the help.

After much testing, I realize the error is because of the way I set the named ranges. My named ranges exist in another sheet, instead of sheet1.

Got a question for Smallman. May I refer to your code shown below.

sum1 = WorksheetFunction.Sum(Sheet1.Range("A2", Sheet1.Range("A" & Rows.Count).End(xlUp)))

It's summing up Cell A2 to Cell A(last used row) right? That eliminates the need for named ranges?

Hi,

I have declared 2 named ranges on Excel interface. Name ranges are called Test1 and Test2.

Now I need to convert both named ranges into VBA ranges. And subtract the sum of one range from the sum of the other range.

I am using this code which didn't work.

Dim Test1vba, Test2vba as range
Dim sum1, sum2,netvalue as double


with thisworkbook.sheets("sheet1") 
Set Test1vba = Range("Test1")
Set Test2vba = Range("Test2")


Sum1 = Application.WorksheetFunction.Sum(Test1vba)
Sum2 = Application.WorksheetFunction.Sum(Test2vba)


Netvalue = sum1-sum2


End with

Code gets stuck at Set Test1vba.

Please advise. Thank you in advance.

Re: In-Cell formula to compare time

Thanks! It works!

Hi,

I need to formulate a series of in-cell formula to compare current time against an operating period.

Cell A1 contains current date and time. In-cell formula : =NOW()
Cell B1 contains lower bound of operating period. In-cell formula: =Time(8,0,0)
Cell C1 contains upper bound of operating period. In-cell formula: =Time(22,0,0)

To compare A1 to see if it falls between B1 and C1, I use this formula
= AND(A1>B1,A1<C1)

However, these are not working for me. Reason is because Cells B1 and C1 have an in-built date of 00 January 1900. It will not return a proper result if compared against A1, which holds today's date.

I just want to compare time, not dates or days. Any advise?

Many thanks in advance.

Re: Need help with run-time error 1004

Hi Norie,

Your code will produce an error of ('Run time error 1004. The extract range has a missing or illegal field name').

However, the following code works too. Seems like the .Range("A1:A5000").Select is not necessary.

With ThisWorkbook.Sheets("coy list")
    .Select
    '.Range("A1:A5000").Select
    .Range("A1:A5000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:A5000"), CopyToRange:=Range("B1"), Unique:=True
End With

Re: Need help with run-time error 1004

I will get back to you on Monday. The excel file is in my office computer. Will try it out and let you know!

Re: Need help with run-time error 1004

Hi guys,

Thanks for all your replies. My code is working fine now. The corrected code is as follow.

With ThisWorkbook.Sheets("coy list")
    .Select
    .Range("A1:A5000").Select
    .Range("A1:A5000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:A5000"), CopyToRange:=Range("B1"), Unique:=True


End With

Many thanks!!

Hi, I am trying to use VBA to sort a list of company names into a unique list on the same sheet.
However, the code always gives me an error code of 'Run time error 1004. The extract range has a missing or illegal field name''.

My code is as follow:

Sub colourcoding()


Dim foundcell, foundcell2, entrow, rng As Range
Dim coycol, coyrow, lastrow, i, j As Integer
Dim coylist(5000) As Variant


ThisWorkbook.Sheets("coy list").Range("A:Z").Clear
ThisWorkbook.Sheets("PCT Inorg").Range("A:IV").Interior.ColorIndex = 0


With ThisWorkbook.Sheets("PCT Inorg")


    lastrow = .Cells(25500, 1).End(xlUp).Row
    Set foundcell = .Cells.Find(what:="company name", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)


    If Not foundcell Is Nothing Then
        coycol = foundcell.Column
        coyrow = foundcell.Row


        For i = coyrow + 1 To lastrow
            coylist(i) = .Cells(i, coycol)
            ThisWorkbook.Sheets("coy list").Cells(i - 3, 1) = coylist(i)
        Next i
    End If
End With


With ThisWorkbook.Sheets("coy list")
    Range("A1:A5000").Select
    Range("A1:A5000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:A5000"), CopyToRange:=Range("B1"), Unique:=True


End With


lastrowunique = ThisWorkbook.Sheets("coy list").Cells(25500, 2).End(xlUp).Row
j = 3
For i = 1 To lastrowunique


    company = ThisWorkbook.Sheets("coy list").Cells(i, 2)
    
        With ThisWorkbook.Sheets("PCT Inorg")
            
            Set foundcell2 = .Cells.Find(what:=company, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            
            If Not foundcell2 Is Nothing Then
                firstadd = foundcell2.Address
            End If
            
            Do Until foundcell2 Is Nothing
                
                Set foundcell2 = .Cells.FindNext(after:=foundcell2)
                coyrow2 = foundcell2.Row
                
                If j < 56 Then
                    If Not foundcell2 Is Nothing Then
                        Set entrow = ThisWorkbook.Sheets("PCT Inorg").Range("A" & coyrow2 & ":" & "H" & coyrow2)
                        entrow.Interior.ColorIndex = j
                    End If
                Else
                j = 3
                    If Not foundcell2 Is Nothing Then
                        Set entrow = ThisWorkbook.Sheets("PCT Inorg").Range("A" & coyrow2 & ":" & "H" & coyrow2)
                        entrow.Interior.ColorIndex = j
                    End If
                End If
                
                If foundcell2.Address = firstadd Then
                    j = j + 1
                    Exit Do
                End If
            Loop
        End With
Next i


End Sub

When I click on debug, the following line is highlighted in yellow.

Range("A1:A5000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:A5000"), CopyToRange:=Range("B1"), Unique:=True

The only way to solve this is to go the sheet 'Coy list'. Click on any cell on this sheet and continue running the macro again (press F5).

This is how I solve this error. But how should I prevent this from happening?

Many thanks!

Re: Need help with Application/Object defined error

I think I know what you mean. Will do according to your method.

Thanks!

Hello

I am trying to write a code that eliminates double counting.

On Column 8, some cells are populated with "1". These rows have a serial number on Column 6. I want to search for this serial number in the entire sheet. If the same serial number is found again, the digit on Column 8 on the corresponding row is to be changed to "0"

The code is as follow:

Sub removedoublecount()


Dim cellref, foundcell As Range
Dim sample As Integer


lastrow = ThisWorkbook.Sheets("PCT Inorg").Cells(25550, 1).End(xlUp).Row


With ThisWorkbook.Sheets("PCT Inorg")


    If .Cells(35, 8) = "1" Then
        Set cellref = .Cells(34, 8).Offset(0, -2)


        .Cells(35, 10) = serial
        Set foundcell = .Cells.Find(what:=serial, LookIn:=xlValues, searchorder:=xlByRows, lookat:=xlWhole, MatchCase:=True)
        firstadd = foundcell.Address


        Do Until foundcell Is Nothing
            Set foundcell = .Cells.FindNext(after:=foundcell)
            
            If Not foundcell Is Nothing Then
               sample = foundcell.Offset(0, 2).Value
               
                If sample = "1" Then
                    foundcell.Offset(0, 2) = "0"
                End If
            End If
            
            If foundcell.Address = firstadd Then
                foundcell.Offset(0, 2) = "1"
                Exit Do
            End If
        Loop
    End If
End With
End Sub

I am having an application/object defined error on this line.

If Not foundcell Is Nothing Then
               sample = foundcell.Offset(0, 2).Value

How should I improve my code? Please advise.

Thanks!!

Hi,

I have a code that is working fine.

The code searches a sheet 'License PWC' for the word 'Renewal'. If the word is found, it copies the entire row of data to another sheet 'expiry due 60d'. The rows of data are populated to column 12.

Now, I would like to add in another feature. Column 13 is populated with "yes" and "no". If the word "renewal" is found, and if column 13 of that row is "no", only then it will transfer the data into sheet 'expiry due 60d'.

My code is as shown:

With ThisWorkbook.Sheets("License PWC")
    
    lastrow = .Cells(25535, 1).End(xlUp).Row


        Set foundcell = .Cells.Find(what:="Renewal", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlDown, MatchCase:=False)
        
        If Not foundcell Is Nothing Then
            firstadd = foundcell.Address
        End If
        
        m = ThisWorkbook.Sheets("expiry due 60d").Cells(25535, 1).End(xlUp).Row + 1
        
        
        Do Until foundcell Is Nothing
            Set foundcell = .Range("H:H").FindNext(after:=foundcell)
            expiredrow = foundcell.Row
            
'            If .Cells(expiredrow, 13) = "No" Then
            
                For i = 0 To 11
                    data(i) = .Cells(expiredrow, i + 1)
                    ThisWorkbook.Sheets("expiry due 60d").Cells(m, i + 1) = data(i)
                Next i
                
                m = m + 1
                
                If firstadd = foundcell.Address Then
                    Exit Do
                End If
            
'            End If
        Loop


End With

The code above works fine, without the added feature.
I have tried to add in that feature with a IF command (commented out in the above code). If I uncomment the If command, the code runs into an infinite loop.

Upon debugging, the following line is highlighted in yellow.

expiredrow = foundcell.Row

How should I include that feature into my exisiting code?

Many thanks!

Re: When to use Set function

Thanks cytop. I know my mistake now.

Re: When to use Set function

Thanks for your reply. I think I understand a little better now.

I want to store the row number into 'corow'. Now I get the error message whether I use the Set function or not.

How should I change the following code?

With ThisWorkbook.Sheets("2011")
    
    company2 = ThisWorkbook.Sheets("customer lost").Cells(2, 1)
    
    Set corow = .Cells.Find(what:=company2, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Row
    
    
    
End With

Hi guys,

Please see the 2 codes below.

corow = .Cells.Find(what:="ABC", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Row

Set corow = .Cells.Find(what:="ABC", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Row

I am trying to find ABC and store its row number into variable 'corow'. I have done this for multiple times on different files, but sometimes I get error messages when I use the Set function. Sometimes I get error messages when I do not use the Set function.

The error message I always encounter is 'Object variable not set'. I have declared my variable corow as an integer

Please advise me on when to use the Set function.

Re: VBA Macro Code To Sum Up Values Across Multiple Columns

Hi Jidon,

That is clear enough. Thanks for your explanation!

Re: Add up values across multiple columns

Quote from jindon;610068

try

Code

Sub test()
With Sheets("temp1").Range("a1").CurrentRegion
    If .Cells(.Rows.Count, 1).Value <> "Total" Then
        With .Offset(.Rows.Count).Resize(1)
            .Formula = "=sum(r2c:r[-1]c)"
            .Columns(1).Value = "Total"
        End With
    End If
End With
End Sub

Hi Jindon,

your code works great! However there are some parts which I do not understand. Mind explaining them briefly to me?

I would like to know the significance of

.Offset(.Rows.Count).Resize(1)

and

sum(r2c:r[-1]c)

how did you get the r2c:r[-1]c expression?

Thanks!

Hi,

I have a spreadsheet of the following layout.
Column A - list of companies
Columns B to O - populated with numbers

I want to add in an additional row at the end of spreadsheet. This additional row tabulates the SUM of all values for each Column (B to O). How should I do it via loops and worksheet function SUM?

This is the code that does not work.

With ThisWorkbook.Sheets("temp1")
        
        lastrow = .Cells(25536, 1).End(xlUp).Row
        .Cells(lastrow + 1, 1) = "Total"
        
        For o = 2 To 15
            .cells(lastrow+1, o)= application.WorksheetFunction.Sum(Cells(1,o): Cells(lastrow,o))
        Next o
        
End With

Re: FindNext function to search for repetitions in a column of data

Thanks cytop! It works!

Hi guys,

I have a list of companies populated on Column A. Most companies found on this list are repeated numerous times. I want to find out the row number at which each company is found to be repeated at. (eg, if company ABC is repeated 10 times on the list, I want to obtain the 10 row numbers at which this occurs).
I have done up a code which does not work. It loops indefinitely at the Do-loop. Would you please feedback on my code? Thanks!

Sub sortunique()


Dim com1, com2, com3, com4, com5, firstadd As String


With ThisWorkbook.Sheets("5 year summary 2007-2011")
     With Range("A:A")
    Set lastcell = .Cells(.Cells.Count)
End With


    com1 = “ABC GLOBAL  COMPANY”
    com2 = Left(com1, 12)
    Set foundcell = .Cells.Find(what:=com2, after:=lastcell, LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlDown, MatchCase:=False)
    
If Not foundcell Is Nothing Then
      	  firstadd = foundcell.Address
End If


Do Until foundcell Is Nothing
        Debug.Print foundcell.Address
        Set foundcell = .Range("A:A").FindNext(after:=foundcell)
        
        If foundcell = firstadd Then
        Exit Do
        End If
               
Loop
    
End With
End Sub