Page 4 of 4 FirstFirst ... 234
Results 31 to 33 of 33

Thread: VBA to see if a column contains a certain string
Thanks Thanks: 0 Likes Likes: 0

  1. #31
    Board Regular
    Join Date
    Aug 2018
    Location
    NSW, Australia
    Posts
    935
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to see if a column contains a certain string

    Maybe I have accidentally changed something. Could you look at the cmdSend code to see if I have mistakenly added something. It is the code that is run that copies the row across to tblCosting. tblCosting is the table that has the extra column that is all the same colour.

  2. #32
    Board Regular
    Join Date
    Aug 2018
    Location
    NSW, Australia
    Posts
    935
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to see if a column contains a certain string

    Sorry about that, i forgot to include the code

    Code:
    Sub cmdSend()
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Dim desWS As Worksheet, srcWS As Worksheet
            Set srcWS = ThisWorkbook.Sheets("NPSS_quote_sheet")
            Set desWS = ThisWorkbook.Sheets("Costing_tool")
        Dim lastRow1 As Long, lastRow2 As Long
        Dim i As Long, x As Long, header As Range
            lastRow1 = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
            lastRow2 = desWS.Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
        With srcWS.Range("A:A,B:B,H:H")
            If lastRow2 < 5 Then
                lastRow2 = 5
                For i = 1 To .Areas.Count
                    x = .Areas(i).Column
                    Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy
                        desWS.Cells(lastRow2, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    End If
                Next i
                With desWS
                    If .Range("A" & .Rows.Count).End(xlUp).Row > 5 Then
                        desWS.ListObjects.Item("tblCosting").ListRows.Add
                    End If
                    .Range("D" & lastRow2 & ":D" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("G7")
                    .Range("F" & lastRow2 & ":F" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("B7")
                    .Range("G" & lastRow2 & ":G" & .Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row) = srcWS.Range("B6")
                End With
            Else
                lastRow2 = desWS.Range("A:A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
                desWS.ListObjects.Item("tblCosting").ListRows.Add
                For i = 1 To .Areas.Count
                    x = .Areas(i).Column
                    Set header = desWS.Rows(4).Find(.Areas(i).Cells(10), LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        srcWS.Range(srcWS.Cells(11, x), srcWS.Cells(lastRow1, x)).Copy
                        desWS.Cells(lastRow2 + 1, header.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    End If
                Next i
                With desWS
                    .Range("D" & lastRow2 + 1 & ":D" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("G7")
                    .Range("F" & lastRow2 + 1 & ":F" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B7")
                    .Range("G" & lastRow2 + 1 & ":G" & .Range("A" & .Rows.Count).End(xlUp).Row) = srcWS.Range("B6")
                End With
            End If
        End With
        desWS.ListObjects("tblCosting").Sort.SortFields.Clear
        desWS.ListObjects("tblCosting").Sort.SortFields. _
            Add Key:=desWS.Cells(, 1), SortOn:=xlSortOnValues, Order:= _
            xlAscending, DataOption:=xlSortNormal
        With desWS.ListObjects("tblCosting").Sort
            .header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        With Application
            .CutCopyMode = False
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Dim oLst As ListObject
            Dim lr As Long, rng As Range
            lr = desWS.Cells(Rows.Count, "A").End(xlUp).Row
            For i = lr To 4 Step -1
                Set rng = desWS.Cells(i, 1)
                If WorksheetFunction.CountBlank(rng) = 1 Then
                    desWS.Rows(i).Delete
                End If
            Next i
    End Sub

  3. #33
    Board Regular Michael M's Avatar
    Join Date
    Oct 2005
    Location
    South Western NSW
    Posts
    17,804
    Post Thanks / Like
    Mentioned
    18 Post(s)
    Tagged
    2 Thread(s)

    Default Re: VBA to see if a column contains a certain string

    There is nothing in that code that affects the colour that i can see !!
    Regards
    Michael M
    ---------------------------------------
    The more I learn, the less I seem to know.....A Please and Thank You cost nothing !
    It's easier to debug if we can see the whole macro !
    Home 2007 & 2013

    - Posting guidelines, forum rules and terms of use

    - To download Mr Excel HTML Maker

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


    [CODE]Place Your Code Here[/CODE]

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •