macro for numbers

Beekman

Board Regular
Joined
Nov 7, 2008
Messages
64
Hi everyone,

Need help with this. Have a list of numbers say 4000 to 4030 and 4100 to 4130 in col A5 down, in sheet1

would like to have these in Col A5 in sheet2 but with the numbers 4100 to 4130 listed twice below each other, eg

sheet1
col A5
4000
4001
4002
4003
etc
4100
7101
4102
4103
4104
etc


sheet2
4000
4001
4002
4003
4004
etc
4100
4100
4101
4101
4102
4102
4103
4103
4104
4104
etc
Is this possible with a macro as I want to build on that for other columns?

Thanks, Ben
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Try:-
Code:
[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub CopyBlockTwice()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim iLastRow As Long
  Dim iRow As Long
  
  Set ws1 = ThisWorkbook.Sheets(1)
  Set ws2 = ThisWorkbook.Sheets(2)
  
  iLastRow = ws1.Range("A5").End(xlDown).Row
  
  ws1.Range("A5:A" & iLastRow).Copy Destination:=ws2.Range("A5")
  ws1.Range("A5:A" & iLastRow).Copy Destination:=ws2.Range("A5").Offset(iLastRow - 4, 0)[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]End Sub[/FONT]
 
Upvote 0
I need it to double input on numbers 4100,4101,4102 etc not on 4000 4001 4002

4000
4001
4002
4100
4100
4101
4101
 
Upvote 0
Try:-
Code:
[FONT=Fixedsys]Option Explicit
 
Public Sub CopyBlockTwice()
 
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim iLastRow As Long
  Dim iRow As Long
  Dim iOutRow As Long
  
  Set ws1 = ThisWorkbook.Sheets(1)
  Set ws2 = ThisWorkbook.Sheets(2)
  
  iLastRow = ws1.Range("A5").End(xlDown).Row
  
  iOutRow = 4
  For iRow = 5 To iLastRow
    iOutRow = iOutRow + 1
    ws1.Cells(iRow, "A").Copy Destination:=ws2.Cells(iOutRow, "A")
    If ws1.Cells(iRow, "A").Value >= 4100 And ws1.Cells(iRow, "A").Value <= 4130 Then
      iOutRow = iOutRow + 1
      ws1.Cells(iRow, "A").Copy Destination:=ws2.Cells(iOutRow, "A")
    End If
  Next iRow
 
End Sub
[/FONT]
 
Upvote 0
Not having much luck. When I test on a new spreadsheet works o.k. but when I want to name macro, say macro10, then I can't get it to run if I try to change sheet1 to another name. It highlites Sub macro10 or Option Explicit or Public Sub Copyblocktwice. Sheet1 will be called HEADER and sheet2 will be MONDAY.
I would like this to happen on 5 sheets named Monday thru to FRIDAY.

What does Option explicit mean and does Public Sub Copyblocktwice() have to be in there?

I'm not familiar with macro's as you can tell.

Thanks Ben
 
Upvote 0
You can call the macro whatever you like. In any module, all the procedures must have different names. Public Sub CopyBlockTwice is the line which defines the subroutine: you have to have a Sub line of some sort.

You can change the sheet names to point to any sheets:-
Code:
[FONT=Fixedsys]  Set ws1 = ThisWorkbook.Sheets("HEADER")
  Set ws2 = ThisWorkbook.Sheets("MONDAY")
[/FONT]

Option Explicit is a safety feature which reports potential problems before they occur: don't remove it.

I think what you actually want is a piece of code which will perform this action to any worksheet rather than a specific one. Shall we start again?

Open a new workbook and create sheets called HEADER, MONDAY, TUESDAY, WEDNESDAY, THURSDAY and FRIDAY.

In VBA, create a new general code module and paste this into it:-
Code:
[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys][FONT=Fixedsys][COLOR=green]' individual routines to copy to each worksheet[/COLOR][/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub DoMonday[/FONT]
[FONT=Fixedsys]  Call CopyBlockTwice("MONDAY")[/FONT]
[FONT=Fixedsys]End Sub[/FONT]
[FONT=Fixedsys] 
[/FONT][FONT=Fixedsys]Public Sub DoTuesday[/FONT]
[FONT=Fixedsys]  Call CopyBlockTwice("TUESDAY")[/FONT]
[FONT=Fixedsys]End Sub[/FONT]
[FONT=Fixedsys] 
[/FONT][FONT=Fixedsys]Public Sub DoWednesday[/FONT]
[FONT=Fixedsys]  Call CopyBlockTwice("WEDNESDAY")[/FONT]
[FONT=Fixedsys]End Sub[/FONT]
[FONT=Fixedsys] 
[/FONT][FONT=Fixedsys]Public Sub DoThursday[/FONT]
[FONT=Fixedsys]  Call CopyBlockTwice("THURSDAY")[/FONT]
[FONT=Fixedsys]End Sub[/FONT]
[FONT=Fixedsys] 
[/FONT][FONT=Fixedsys]Public Sub DoFriday[/FONT]
[FONT=Fixedsys]  Call CopyBlockTwice("FRIDAY")[/FONT]
[FONT=Fixedsys]End Sub[/FONT]
[/FONT][FONT=Fixedsys]
[COLOR=green]' generic routine to copy to specific worksheet[/COLOR]

Public Sub CopyBlockTwice(ByVal aTargetWS as String)
 
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim iLastRow As Long
  Dim iRow As Long
  Dim iOutRow As Long
  
  Set ws1 = ThisWorkbook.Sheets("HEADER")
  Set ws2 = ThisWorkbook.Sheets(aTargetWS)
  
  iLastRow = ws1.Range("A5").End(xlDown).Row
  
  iOutRow = 4
  For iRow = 5 To iLastRow
    iOutRow = iOutRow + 1
    ws1.Cells(iRow, "A").Copy Destination:=ws2.Cells(iOutRow, "A")
    If ws1.Cells(iRow, "A").Value >= 4100 And ws1.Cells(iRow, "A").Value <= 4130 Then
      iOutRow = iOutRow + 1
      ws1.Cells(iRow, "A").Copy Destination:=ws2.Cells(iOutRow, "A")
    End If
  Next iRow
 
End Sub
[/FONT]

Put your number list in HEADER. Run macro DoMonday and check the MONDAY sheet. Has it worked?

Now run DoTuesday, DoWednesday, DoThursday and DoFriday in turn and check the appropriate sheet each time. Is everything working okay?
 
Upvote 0
Option Explicit

Public Sub CopyBlockTwice()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim iLastRow As Long
Dim iRow As Long
Dim iOutRow As Long

Set ws1 = ThisWorkbook.Sheets(1)
Set ws2 = ThisWorkbook.Sheets(2)

iLastRow = ws1.Range("A5").End(xlDown).Row

iOutRow = 4
For iRow = 5 To iLastRow
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws2.Cells(iOutRow, "A")
If ws1.Cells(iRow, "A").Value >= 4100 And ws1.Cells(iRow, "A").Value <= 4130 Then
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws2.Cells(iOutRow, "A")
End If
Next iRow




What I tried before your last reply was add extra
Set ws3 = ThisWorkbook.Sheets("Tuesday")
Set ws4 = ThisWorkbook.Sheets("Wednesday"
Set ws5 = ThisWorkbook.Sheets('Thursday")
Set ws5 = ThisWorkbook.Sheets("Friday")

iOutRow = 4
For iRow = 5 To iLastRow
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws3.Cells(iOutRow, "A")
If ws1.Cells(iRow, "A").Value >= 4100 And ws1.Cells(iRow, "A").Value <= 4130 Then
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws3.Cells(iOutRow, "A")
End If
Next iRow


iOutRow = 4
For iRow = 5 To iLastRow
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws4.Cells(iOutRow, "A")
If ws1.Cells(iRow, "A").Value >= 4100 And ws1.Cells(iRow, "A").Value <= 4130 Then
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws4.Cells(iOutRow, "A")
End If
Next iRow


iOutRow = 4
For iRow = 5 To iLastRow
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws5.Cells(iOutRow, "A")
If ws1.Cells(iRow, "A").Value >= 4100 And ws1.Cells(iRow, "A").Value <= 4130 Then
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws5.Cells(iOutRow, "A")
End If
Next iRow


iOutRow = 4
For iRow = 5 To iLastRow
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws6.Cells(iOutRow, "A")
If ws1.Cells(iRow, "A").Value >= 4100 And ws1.Cells(iRow, "A").Value <= 4130 Then
iOutRow = iOutRow + 1
ws1.Cells(iRow, "A").Copy Destination:=ws6.Cells(iOutRow, "A")
End If
Next iRow


End Sub

Seems to work

With Naming Macro I named it Macro 10 but in the macro box macro 10 comes up but so does CopyBlockTwice

I would actually like to do a lot more with these sheets. Would you be willing to carry on helping me out?? If so shall I keep posting at this location?

Thanks, Ben
 
Upvote 0
What you've done will certainly work.

Generally when designing a program, if there are blocks of code which are repeated more than once then these are made into 'subroutines' which are called with parameters which control the way they behave. In my last post I changed the code so that instead of acting on a single sheet, it was rewritten to expect the sheet name to be passed to it as a parameter which it stores as aTargetWS. When you call it with Call CopyBlockTwice("MONDAY"), it will act on sheet MONDAY, etc.

You can then have separate routines to generate each sheet like I posted and/or you can have a single routine to generate them all in one go:-
Code:
[FONT=Fixedsys]Public Sub DoEveryDay
  Call CopyBlockTwice("MONDAY")
  Call CopyBlockTwice("TUESDAY")
  Call CopyBlockTwice("WEDNESDAY")
  Call CopyBlockTwice("THURSDAY")
  Call CopyBlockTwice("FRIDAY")
End Sub
[/FONT]

The reason for extracting repeated code into separate subroutines is that if you had to change the code for any reason - maybe you found a bug in it or maybe you just decided to change what it did or the way it did it - then you'd only have one piece of code to look at instead of five. You might want to try my code just to satisfy yourself that it works. Save it somewhere in any case, as it demonstrates how parameters are passed to subroutines.

With Naming Macro I named it Macro 10 but in the macro box macro 10 comes up but so does CopyBlockTwice
The macro box lists all the public macros it finds. If Macro10 is the code which currently works, you can delete CopyBlockTwice. Remember: a macro or subroutine starts with a Sub line; the word Sub may be preceded by Private or Public and it will be followed by the name of the Sub and a pair of brackets; the brackets may have the names of parameters in them; and the macro ends with an End Sub line. Make sure you don't delete anything which belongs to an adjacent macro! I always insert an extra line between macros just to keep them apart and a lot of people insert one or more comment lines for the same reason.

One thing I would definitely recommend is that you rename your macro something more meaningful, otherwise when you have a few more of them, you're very likely to forget which one does what.

I would actually like to do a lot more with these sheets. Would you be willing to carry on helping me out?? If so shall I keep posting at this location?
I do check in to the board fairly often and I'm quite happy to respond to any posts where I feel I can help, as indeed are many other people, many of whom are much more knowledgeable and experienced than I am. I can't guarantee to respond to everything you post: as you can see from my profile, I have 4000+ posts in my name - if I were to guarantee a personal service to each of the people I'd responded to in the past I'd never get anything else done!

For the same reason, in common with many of the other regulars, I tend to ignore any private messages asking for assistance where I feel that posting in the public forum is more appropriate. Posting publicly is usually to be preferred and there are several reasons for this:-
  • There may be other people who experience a similar problem in the future, so having the discussion in public allows people to find a solution more easily in the future. (In fact MrExcel posts normally appear in Google search results within minutes of being posted!)
  • If you post to the board, you're almost certain to have an answer within a few hours - sometimes even within a few minutes - whereas sending private messages relies on the recipient checking in to the board.
  • Posting in public will elicit a number of responses offering a wide range of different techniques, some of which will be better, faster or more elegant than others. You will be able to choose the one which is the most suitable for you and learn a lot in the process.
  • Relying on a single person for a solution puts you at the mercy of his abilities. If you pick the wrong person you might find yourself heading down a completely inappropriate road.
 
Upvote 0
Thanks for the feedback. If I can help in the future, I will - if I can get in fast enough. There are some very speedy types around and when I said you can often get your question answered in minutes, I wasn't exaggerating!
 
Upvote 0

Forum statistics

Threads
1,224,618
Messages
6,179,917
Members
452,949
Latest member
beartooth91

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