Macro issues with VB code

J

jaipurhandsome

New Member
Joined
Aug 6, 2013
Messages
5
1. i want to Create a border around items with row 1(name) (do not look at size-number after last dash) and same item title.how please write code if cell

2. Highlght in yellow group of items (row1+ row2) where some status is 100% not linked and available of atleast 1 row is >0
4. Highlght in orange any row with in a Group where 4th row status = not linked and available is >0, but others within the group are linked
5. Count groups falling into #3
6. Count groups falling into #4
7. Save as EXCEL Workbook

<TBODY>
</TBODY>

<TBODY>
</TBODY>
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
SKU ItemTitleAvailableLastUpdateDate EBAYEBAY0status
1 O'Neill Wetsuit Wash257/5/2011 17:21 OK
44 Seal Cement 2 oz95/16/2011 12:36 Not Linked
BLU-3XL 7mm Sport Mens Full Suit1 5/16/2011 12:36 Not Linked
00217mm Sport Mens Full Suit1 5/16/2011 12:36 OK
002117mm Sport Mens Full Suit1 6/28/2011 13:23 OK
002157mm Sport Mens Full Suit1 7/29/2011 14:09 OK
0021517mm Sport Mens Full Suit2 5/16/2011 12:36 OK
0021517mm Sport Mens Full Suit2 5/16/2011 12:36 OK
0021517mm Sport Mens Full Suit2 5/16/2011 12:36 OK
0021517mm Sport Mens Full Suit1 5/16/2011 12:36 OK
0021517mm Sport Mens Full Suit1 5/16/2011 12:36OK
002151 7mm Sport Mens Full Suit1 5/16/2011 12:36Not Linked
002151 7mm Sport Mens Full Suit15/16/2011 12:36OK
0021533/2mm Sport Mens Full Suit25/16/2011 12:36OK

<TBODY>
</TBODY><COLGROUP><COL><COL><COL span=4></COLGROUP>
 
Upvote 0
You can edit the below code to suit the items that you have but if you want to make a border here is some code that I found:

Code: 
Sub Border()
     
    Dim r As Long
    r = Range("A7").End(xlDown).Row
     
    ApplyBorder Range("A" & r)
    ApplyBorder Range("C" & r)
    ApplyBorder Range("E" & r)
    ApplyBorder Range("G" & r)
     
End Sub
Sub ApplyBorder(ToRange As Range)
     
    With ToRange
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlHairline
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlHairline
            .ColorIndex = xlAutomatic
        End With
    End With
     
End Sub

Just edit the ranges to suit the border that you want, this only makes the border not the rest of it. If you google around for the rest of the stuff I'm sure you will be able to find it
 
Last edited:
Upvote 0
Upvote 0
i want to Highlght in orange any row with in a Group where 4th row status = not linked and available is >0, pls see in my data in reply
 
Upvote 0
Upvote 0
jaipurhandsome said:
thanks buddy . i will revert you when its complete .
Click to expand...

I will try mess around with it and see if I can get it working too, but I am not to sure what the conditions are for the colouring of the cells for part two do you want the cell to be yellow if the number of items available is less than one. Is that what you want it to do ?
 
Upvote 0
K i messed around with it and I think I have most of what you need, you can edit the code anyway to suit any further things that you want:

I have two modules in the first is this

Module1:

Code: 
Sub Master()


Call Border
Call ColourCondition1
Call ColourCondition2
Call SaveFunction


End Sub

Module2:

Code: 
Sub Border()


    ApplyBorder Range("B2:B16")
     
End Sub
Sub ApplyBorder(ToRange As Range)
     
    With ToRange
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlHairline
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlHairline
            .ColorIndex = xlAutomatic
        End With
    End With
     
End Sub


Sub ColourCondition1()


    With Sheet1
        For Each rCell In .Range("E2:E16")
            If rCell.Value = "Not Linked" Then
                rCell.Interior.ColorIndex = 46
            End If
        Next rCell
    End With
    
End Sub


Sub ColourCondition2()


    With Sheet1
        For Each rCell In .Range("C2:C16")
            If rCell.Value <= 1 Then
                rCell.Interior.ColorIndex = 6
            End If
        Next rCell
    End With
    
End Sub


Sub SaveFunction()


ThisWorkbook.Save


End Sub

The only thing that you need to add is the counting up the cells that are coloured, and you can do that from this link:

Count The Number of Cells With Specific Cell Color By Using VBA

Hope this helps

- DeusXv
 
Upvote 0
i paste data here and all conditions which is not completing yet .i hope you understand .
SKU
ItemTitle
Available
LastUpdateDate
EBAY EBAY0 status
144
O'Neill Wetsuit Wash
25
7/5/2011 17:21
OK
10001
Online Sales Tax
5/16/2013 12:36
Not Linked
12807
Cirrus Purge Set
5/16/2013 12:36
Not Linked
14114
Seal Cement 2 oz
9
5/16/2013 12:36
Not Linked
14416
Seal Cemenet 4oz
1
7/29/2013 14:19
Not Linked
18136
SB System Mid Layer Top
5/16/2013 12:36
Not Linked
18137
SB System Mid Layer Pant
5/16/2013 12:36
Not Linked
24061
HangAir Wetsuit Hanger
35
7/29/2013 14:19
Not Linked
24068
HangAir 12V Power Supply
1
7/31/2013 11:53
Not Linked
28115
MAX WAX 3/4 oz. (Bc)
7/5/2013 17:21
Not Linked
29116
Zip Care 2oz Blistered
12
5/16/2013 12:36
Not Linked
30120
Wet & Dry Suit Shampoo
7/29/2013 14:19
Linked, no active
34118
BC Life 8oz
3
7/15/2013 21:08
OK
36115
MIRAZME 8 oz.
7/29/2013 14:19
Not Linked
36132
Mirazyme 2oz
60
7/15/2013 21:08
Not Linked
87088
DIVERS VALUE PACK
10
7/29/2013 14:19
Not Linked
88944
Quick Clamp
5/16/2013 12:36
Not Linked
88945
Bare Dry Glove Set
5/16/2013 12:36
Not Linked
200400
Kick Board
4
5/16/2013 12:36
Not Linked
302190
SWIMMERS DRY TOWEL
25
7/29/2013 14:09
Not Linked
414117
Dive Computer Puck Wrist
2
5/16/2013 12:36
Not Linked
414122
Dive Computer PUCK Pro
1
5/16/2013 12:36
Not Linked
414162
Mares Puck Air w/Compass
1
5/16/2013 12:36
Not Linked
414418
Mission 2 Gauge
1
5/16/2013 12:36
OK
414419
Mission 3 Gauge
1
5/16/2013 12:36
OK
414420
Mission Puck 2
2
7/15/2013 21:08
OK
414421
Mission Puck 3
1
5/16/2013 12:36
OK
415574
Mares Cruise X-Strap Bag
2
5/16/2013 12:36
Not Linked
415577
Mares Cruise Regulator Bag
4
5/16/2013 12:38
Not Linked
415596
Mares Cruise Mesh
2
5/16/2013 12:36
Not Linked
416134
Abyss 22 Regulatro
1
5/16/2013 12:36
Not Linked
416156
Prestige 12S She Dives Reg
2
5/16/2013 12:36
OK
416166
Mares Rover 12S Regulator
1
5/16/2013 12:36
Not Linked
416182
Prestige 12S Regulator
7/15/2013 21:08
Linked, no active
416505
Octo Rover
7/29/2013 14:19
Linked, no active
416523
Mares Octo MV
2
7/15/2013 21:08
Not Linked
416526
Octo Prestige
3
5/16/2013 12:36
OK
8.73855E+11
Helium 4 Bottle Belt
5/16/2013 12:36
Not Linked
8.73855E+11
Helium 4 Bottle Belt
5/16/2013 12:36
Not Linked
8.73855E+11
Helium 4 Bottle Belt
5/16/2013 12:36
Not Linked
8.73855E+11
Helium 4 Bottle Belt
5/16/2013 12:36
Not Linked
002117-STL-MS
Mens 7mm Arctic Full
1
5/16/2013 12:36
Not Linked
002145-RYL-L
3/2 mm Ignite Mens Full Suit
7/15/2013 21:08
Not Linked
002145-RYL-M
3/2 mm Ignite Mens Full Suit
2
5/16/2013 12:36
OK
002145-RYL-ML
3/2 mm Ignite Mens Full Suit
5/16/2013 12:36
Not Linked
002145-RYL-S
3/2 mm Ignite Mens Full Suit
1
5/16/2013 12:36
OK
002145-RYL-XL
3/2 mm Ignite Mens Full Suit
1
5/16/2013 12:36
OK
002145-RYL-XXL
3/2 mm Ignite Mens Full Suit
2
5/16/2013 12:36
OK
002151-BLU-3XL
7mm Sport Mens Full Suit
1
5/16/2013 12:36
Not Linked
002151-BLU-L
7mm Sport Mens Full Suit
1
5/16/2013 12:36
OK
002151-BLU-LS
7mm Sport Mens Full Suit
1
6/28/2013 13:23
OK

<TBODY>
</TBODY>
conditions are
2. Create a border around items with same sku (do not look at size-number after last dash) and same item title
3. Highlght in yellow group of items (same sku + item title) where ebay status is 100% not linked and available of atleast 1 row is >0
4. Highlght in orange any row with in a Group where ebay status = not linked and available is >0, but others within the group are linked
5. Count groups falling into #3
6. Count groups falling into #4

<TBODY>
</TBODY><COLGROUP><COL span=13></COLGROUP>
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Macro for copying data from multiple sheets to a common sheet based on a cell value
Replies
0
Views
232
jmk15315
J
K
  • Question
Lottery Combinations Filter
Replies
2
Views
578
Fluff
Fluff
E
  • Question
VB Help with code to copy selected rows to specified cells in another sheet.
2
Replies
12
Views
429
Excel_Assis
E
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
186
sspatriots
S
J
  • Locked
  • Question
Still need help on a daily summary sheet
Replies
1
Views
332
Fluff
Fluff

Forum statistics

Threads
1,215,633
Messages
6,125,922
Members
449,274
Latest member
mrcsbenson

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top