The below script gets the configuration of each machine name in colum Q. I want the cells color to change to Yellow

bsharath,

First things first,

To change the cell color to Yellow whenever there is a change for the configuration, you need to set that up in the Worksheet_Change event.  See code below for example.

Then to color cells Red for ping or permission issues, in the code you have above you need to use similar formatting code as the change event.  I'm not sure where you detect these issues in the code, but wherever it is you would need something like

With Cells(lngRow, "Q").Interior
  .ColorIndex = RGB(255,0,0) 'Red
  .Pattern = xlSolid
End With

Cheers,
WC

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target,Range("Q:Q")) Is Nothing Then
    With Target.Interior
      .ColorIndex = RGB(255,255,0) 'Yellow
      .Pattern = xlSolid
    End With
  End If
End Sub

Select allOpen in new window

My apologies,

So use to using the colorindex property.

Please remove that for just the Color property to use the RGB function to set the color.

So something like this.

With Cells(lngRow, "Q").Interior
  .Color = RGB(255,0,0) 'Red
  .Pattern = xlSolid
End With

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target,Range("Q:Q")) Is Nothing Then
    With Target.Interior
      .Color = RGB(255,255,0) 'Yellow
      .Pattern = xlSolid
    End With
  End If
End Sub

Select allOpen in new window

Thank U
Instead of the code in thisworkbook session
Can i get a way that my maion code has the capability to change the color when there is a change. Each time i run....

I'm not clear on what you're asking.  You want to color cells in column Q when they are changed, correct?  As far as I know, this has to be done in the worksheet_change event.

If you want your main code to detect changes, then you would have to store the values in a separate column and compare the "old" column of data to the "new" column, and at the end of the code, replace the "old" column with the "new" column.

It seems like a whole lot of extra work for something that is already built into Excel.

WC

Hi Sharath,

I think I have this right....give this a shot.

Regards,

Rob.

Sub Get_Configuration_Remote()
    'Get the Configuration of a machine Processor,Ram,CDD,FDD,HDD
    'Direct Machine
    Application.DisplayAlerts = False
    Dim objWMI
    Dim lngRow As Long, lngRowCount As Long
    lngRowCount = Cells(65536, "Q").End(xlUp).Row
 
    'assumes header in row 1
    For lngRow = 2 To lngRowCount
        If (Cells(lngRow, "W").Value = "Could not be contacted." Or Cells(lngRow, "W").Value = "") And Cells(lngRow, "Q").Value <> "" Then
            intHDD1 = 0
            intHDD2 = 0
            strPC = Cells(lngRow, "Q")
            On Error Resume Next
            Set objWMI = GetObject("winmgmts:\\" & strPC & "\root\CIMV2")
            If Err.Number = 0 Then
                Set colItems = objWMI.ExecQuery("Select * From Win32_Processor")
                For Each objItem In colItems
                    strProcessor = Trim(Replace(Replace(objItem.Name, "Intel", ""), "(R)", ""))
                Next objItem
                Set colItems = objWMI.ExecQuery("Select * From Win32_OperatingSystem")
                For Each objItem In colItems
                    strRAM = returnRAM(objItem.TotalVisibleMemorySize)
                Next objItem
                'Set colItems = objWMI.ExecQuery("Select * From Win32_LogicalDisk Where DriveType=3")
                Set colItems = objWMI.ExecQuery("Select * From Win32_DiskDrive")
                For Each objItem In colItems
                    If Not IsNull(objItem.Size) Then
                        isize = objItem.Size / 1024 / 1024 / 1024
                        If intHDD1 = 0 Then
                            intHDD1 = FormatNumber(intHDD1 + isize, 2)
                        Else
                            intHDD2 = FormatNumber(intHDD2 + isize, 2)
                        End If
                    End If
                Next objItem
                intHDD1 = Int(intHDD1) & "Gb"
                If intHDD2 > 0 Then
                    intHDD2 = Int(intHDD2) & "Gb"
                Else
                    intHDD2 = ""
                End If
                Set colItems = objWMI.ExecQuery("Select * from Win32_FloppyDrive")
                If colItems.Count = 0 Then
                    strFloppy = ""
                Else
                    strFloppy = "FDD"
                End If
                Set colItems = objWMI.ExecQuery("Select * from Win32_CDROMDrive")
                If colItems.Count = 0 Then
                    strCD = ""
                Else
                    strCD = "CDD"
                End If
                If Cells(lngRow, "W").Value <> strProcessor Then
                    Cells(lngRow, "W").Value = strProcessor
                    With Cells(lngRow, "W").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                End If
                If Cells(lngRow, "X").Value <> strRAM Then
                    Cells(lngRow, "X").Value = strRAM
                    With Cells(lngRow, "X").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                End If
                If Cells(lngRow, "Y").Value <> intHDD1 Then
                    Cells(lngRow, "Y").Value = intHDD1
                    With Cells(lngRow, "Y").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                End If
                If Cells(lngRow, "Z").Value <> intHDD2 Then
                    Cells(lngRow, "Z").Value = intHDD2
                    With Cells(lngRow, "Z").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                End If
                If Cells(lngRow, "AA").Value <> strFloppy Then
                    Cells(lngRow, "AA").Value = strFloppy
                    With Cells(lngRow, "AA").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                End If
                If Cells(lngRow, "AB").Value <> strCD Then
                    Cells(lngRow, "AB").Value = strCD
                    With Cells(lngRow, "AB").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                End If
            Else
                Cells(lngRow, "W").Value = "Could not be contacted."
                With Range("W" & lngRow & ":" & "AB" & lngRow).Interior
                    .ColorIndex = 3
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
                On Error GoTo 0
            End If ' Err.Number = 0
            Set objWMI = Nothing
        End If
    Next lngRow
    Set objWMI = Nothing
    Application.DisplayAlerts = True
End Sub
 
Function returnASize(rawsize As Double, Optional steps As Variant) As String
    Dim sz As Double
    Dim potentialSize As Variant
    Dim arrOffset
    returnASize = rawsize
    sz = returnASize
    If returnASize = "0" Then returnASize = 0
    If Not IsMissing(steps) Then
        returnASize = 0
        For arrOffset = 0 To UBound(steps)
            If sz > steps(arrOffset) Then
                returnASize = CStr(steps(arrOffset - 1))
                Exit For
            End If
        Next
    End If
End Function
 
Function CBMod(Dividend, Divisor) As Integer
    CBMod = Dividend - (Left(Dividend / Divisor & ".", InStr(Dividend / Divisor & ".", ".") - 1) * Divisor)
End Function
 
Function returnsize(dblSize As Double) As Variant
    Dim cbBytes As Integer
    Dim cbkilo As Integer
    Dim cbMega As Integer
    Dim cbGiga As Integer
    Dim cbTera As Integer
    Dim sizes(0 To 5) As Double
    Dim looper As Integer
    Dim Kbs() As Variant
    Kbs = Array(1024, 768, 640, 512, 384, 256, 128, 0)
    Dim minima() As Variant
    minima = Array(1024, 0)
    Dim halfSplit() As Variant
    halfSplit = Array(1024, 512, 0)
    sizes(0) = dblSize
    For looper = 1 To 5
        sizes(looper) = CBMod(sizes(0), 1024)
        sizes(0) = (sizes(0) - sizes(looper)) / 1024
    Next
    sizes(0) = dblSize
    returnsize = sizes
End Function
 
Function returnRAM(sz As Double) As String
    Dim memSize() As Double
    Dim gbMem As String
    Dim halfSplit() As Variant
    halfSplit = Array(1024, 512, 0)
    memSize = returnsize(1024 * sz)
    memSize(3) = returnASize(memSize(3), halfSplit)
    returnRAM = memSize(4) + (memSize(3) / (2 ^ 10)) & "Gb"
End Function

Select allOpen in new window

Rob i have few issues here with this code..
It does not change color... I guess it skips if already data present..

For machines that have 80 GB HDD i get
81Gb & 82Gb and for some 160 Gb as the size. Which is wrong

The code does not check for Cd drives....

Rob i have few issues here with this code..
It does not change color... I guess it skips if already data present..

For machines that have 80 GB HDD i get
81Gb & 82Gb and for some 160 Gb as the size. Which is wrong

The code does not check for Cd drives....

OK, so do you want it to check every computer every time it's run?

The 81 and 82 GB drives might report as those because of the slightly different sizes of what's available on certain disks.  Are they different makes of hard drives?

I'm not sure why some might report as 160 though....that's odd!  On one of those machines, run this code and see what you get. It will show the size in bytes:

On Error Resume Next

Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

strComputer = "."
   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive", "WQL", _
                                          wbemFlagReturnImmediately + wbemFlagForwardOnly)

   For Each objItem In colItems
      WScript.Echo "DeviceID: " & objItem.DeviceID
      WScript.Echo "Model: " & objItem.Model
      WScript.Echo "Size: " & objItem.Size
   Next


Regards,

Rob.

Yes every time it run each computer has to be checked...

Yes they are of different makes...

Yes every time it run each computer has to be checked...

Yes they are of different makes...

Any views on the CDD>.. None of the Cd drives get detected...

Any views on the CDD>.. None of the Cd drives get detected...

That's odd. It works for me.....the column just says "CDD"

Have you tried clearing cells W to AB for a computer, and trying again?

Rob.

Sorry Rob it does work perfect..

Thanks a lot....

Any help on this
https://www.experts-exchange.com/questions/24533706/Scheduled-task-delete-code-Need-a-condition-to-match-before-deletion.html