Results 1 to 6 of 6

Thread: Antoher piece of code to modify please Help!!![Resolved]

  1. #1

    Thread Starter
    New Member
    Join Date
    Jan 2005
    Posts
    11

    Resolved Antoher piece of code to modify please Help!!![Resolved]

    Hello I have a code here that will find any bold cells in one sheet and caopy that cell and its row to another sheet (thanks Opus and RobDog888), Well my Co-worker had his friend come up with this code that works as well
    VB Code:
    1. Sub TransferDataPlease()
    2. Dim i As Long, n As Long
    3. Dim Sh1 As Worksheet, Sh2 As Worksheet
    4.  
    5. Set Sh1 = ActiveSheet
    6. Set Sh2 = Worksheets("Results") ' insert name here
    7. n = 1
    8. For x = Sh1.Range("A65536").End(xlUp).Row To 3 Step -1
    9.     y = 0
    10.     IsBold = False
    11.     Do
    12.         y = y + 1
    13.         If Sh1.Cells(x, y).Font.Bold = True Then IsBold = True
    14.     Loop While y <= 13 And IsBold = False ' Checks first 13 cols
    15.     If IsBold Then
    16.         n = n + 1
    17.         Sh1.Range("A" & x).EntireRow.Copy Sh2.Range("A" & n)
    18.     End If
    19. Next x
    20. End Sub
    ..Works Fantastic but there is a problem....It pasted the Data from the Bottom to the top on Worksheet2 (example if it were 3 rows to be pasted...instead of pasting row 1of workshheta to row 1 of worksheet b..it would paste row 1 of A into row 3 of B...kinda upsidedown....)

    .... i think the problem is here.
    VB Code:
    1. For x = Sh1.Range("A65536").End(xlUp).Row To 3 Step -1

    Because its searching for results from the bottom to the top.But when i try to modify it by flipping the arguments, it tells me that there is an " expected end of statment error"
    Can someone help me out here?

    thanks for taking a look.
    Last edited by The_Rookie; Jan 10th, 2005 at 06:46 PM.

  2. #2
    Ex-Super Mod RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,709

    Re: Antoher piece of code to modify please Help!!!

    Looks like it is looping through the ENTIRE spreadsheet!!! from bottom to top.
    You dont need to do that at all. You can use the SpecialCells function to find
    the last used row or column in the spreadsheet instead. Also, no need to
    start from the bottom and move up. We can iterate from the top down.

    VB Code:
    1. Workbooks("Book1").Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
    Last edited by RobDog888; Jan 10th, 2005 at 04:42 PM.
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

  3. #3

    Thread Starter
    New Member
    Join Date
    Jan 2005
    Posts
    11

    Re: Antoher piece of code to modify please Help!!!

    Thanks for the quick response RobDog888 so i tried this:
    VB Code:
    1. For x = Sheets("Console").Cells.SpecialCells(xlCellTypeLastCell).Row To 3
    Instead of this :
    VB Code:
    1. For x = Sh1.Range("A65536").End(xlUp).Row To 3 Step -1
    And it still pasted from the Bottom to top...
    I thought with the code on the top...it would go from top to last used cell.
    is that not right?

  4. #4
    Ex-Super Mod RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,709

    Re: Antoher piece of code to modify please Help!!!

    It should be...
    VB Code:
    1. For x = 3 To Sheets("Console").Cells.SpecialCells(xlCellTypeLastCell).Row
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

  5. #5

    Thread Starter
    New Member
    Join Date
    Jan 2005
    Posts
    11

    Re: Antoher piece of code to modify please Help!!![Resolved]

    Looks like we're good to go .....So Far
    Thanks for all your help robDog888

  6. #6
    Ex-Super Mod RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,709

    Re: Antoher piece of code to modify please Help!!![Resolved]

    No prob.
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

Posting Permissions

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



Click Here to Expand Forum to Full Width