VBA - Create Folder/Subfolder based on Today() and single cell values - Copy cells to new sheet

J

JoAv

New Member
Joined
May 14, 2022
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hello everyone, newcomer here.
I am in need of two macros, that do the following tasks. Mini-sheet code posted at the end of the post.

Macro 1
In a Desktop folder named Delivery, the macro:
a) Creates a folder named after the Today() function (cell FORMULAS!H2)
b) Inside DATE folder it creates a subfolder named after the City of the assignment is at (cell FORMULAS!A5)
c) Inside CITY folder it creates a subfolder named after the address of the assignment (cell FORMULAS!A20)

Based on the provided sheet, the end result would look something like this:
C:\Users\user\Desktop\Delivery\Date \City \Address
C:\Users\user\Desktop\Delivery\14 05 2021\Larisa\Petropoulou 10

I review about 20-40 assignments from 11 cities daily, so this means that:
a) The macro works on every reviewed assignment individually, not on a range
b) The date folder will -of course- be created once
c) The addresses must reside in their respective city folders, so any City duplicates should be avoided.

Macro 2
For the second part, I want a macro that copies the range FORMULAS!A53:I54, creates a new STATION.xlsx file and saves in the respective folder I am reviewing. e.g.:
C:\Users\user\Desktop\Delivery\Date \City \Address \*.xlsx
C:\Users\user\Desktop\Delivery\14 05 2021\Larisa\Petropoulou 10\Station.xlsx

Any help would be greatly appreciated.
Cheers!

Formulas Sheet
SL_THESS - Copy.xlsm
ABCDEFGHIJ
1CPJAΔΠΗΜ/ΝΙΑ ΚΑΤΑΣΚΕΥΗΣΜΗΝΑΣΕΤΟΣSERVICE LINE- MOD
2CP38729JA-21-033196ΔΠ-21000931/8/20210821CPCP38729
3ΚΩΔΙΚΟΣ ΠΑΡΟΧΗΣ032-03-S-CP38729
4ΠΟΛΗΤΛOSOSΤΛΚΩΔΙΚΟΣ ΑΡΧΕΙΟΥ03B890311-CP38729
5ΛΑΡΙΣΑΛΑΡΙΣΑΣLARISALARΤομέας Λειτουργίας 03ΣΤΟΝ Τ.Λ. 03 ΛΑΡΙΣΑΣΑΡΙΘΜ. ΣΧΕΔΙΟΥLAR.LP-GP/063-03-B-8903-CP38729/08.21
6ΟΝΟΜΑΣΙΑ ΑΡΧΕΙΟΥ03B890311-CP38729.DWG
7ΤΛ
8DISTRIBUTION NETWORKS AND SERVICE LINES AT O.S. 03 OF LARISAUR
9CPCP38729
10ΚΩΔΙΚΟΣ ΔΙΚΤΥΟΥΔΙΑΤΟΜΗΤ.Λ.BRANCH/LOOPΚΩΔΙΚΟΣΕΠΕΚΤΑΣΗΚΩΔΙΚΟΣ ΠΑΡΟΧΗΣ032-03-R-CP38729
11063-03-B-890306303B8903ΚΩΔΙΚΟΣ ΑΡΧΕΙΟΥ03B890311-CP38729-UR
12ΑΡΙΘΜ. ΣΧΕΔΙΟΥLAR.LP-GP/063-03-B-8903-CP38729-UR/08.21
13ΚΩΔΙΚΟΣ ΑΓΩΓΟΥΟΝΟΜΑΣΙΑ ΑΡΧΕΙΟΥMODΟΝΟΜΑΣΙΑ ΑΡΧΕΙΟΥ03B890311-CP38729-UR.DWG
1403B89031103B890311.DWG00
15
16PRESSUREΤΥΠΟΣΔΙΑΤΟΜΗ SL
17LPGP0Φ32032
18
19ΔΙΕΥΘΥΝΣΗΟΝΟΜΑΑΡΙΘΜΟΣSPIN NUM
20ΠΕΤΡΟΠΟΥΛΟΥ 10ΠΕΤΡΟΠΟΥΛΟΥ 101
21
22ΟΔΟΣ ΠΕΤΡΟΠΟΥΛΟΥ ΔΙΑΤΟΜΗ SLTODAY
23ΟΡΙΖΟΝΤΙΟΓΡΑΦΙΑ ΣΤΗΝ ΟΔΟ ΠΕΤΡΟΠΟΥΛΟΥ 0Φ3203214/5/2022
2410PETROPOULOU
25GROUND PLAN OF 10 PETROPOULOU STREET
26
27
28ΔΙΑΤΟΜΗ ΠΑΡΟΧΗΣΜΗΚΟΣΜΗΚΟΣ ΑΓΩΓΟΥΔΙΑΤΟΜΗ ΠΑΡΟΧΗΣΜΗΚΟΣΜΗΚΟΣ ΑΓΩΓΟΥ
29Φ327.30Φ32 L=7.30mΦ325.36Φ32 L=5.36m
30
31X, Y SPLITTER
32X = 362493.433 Y = 4387086.249
33362493.4334387086.249
34
35SLUR
36BLOCKNAMETEXTBLOCKNAMETEXT
37STREET_NAMEΠΕΤΡΟΠΟΥΛΟΥ STREET_NAMEΠΕΤΡΟΠΟΥΛΟΥ 10
38T.L.Τομέας Λειτουργίας 03T.L.Τομέας Λειτουργίας 03
39DATE_SMALL31/8/2021DATE_SMALL31/8/2021
40DATE_LARGE31/8/2021DATE_LARGE31/8/2021
41JOB_ASSIGNMENTJA-21-033196JOB_ASSIGNMENT0
42CONNECTION_POINTCP38729CONNECTION_POINTCP38729
43CONTRACTΔΠ-210009CONTRACTΔΠ-210009
44PIPE32_LENGTHΦ32 L=7.30mPIPE32_LENGTHΦ32 L=5.36m
45PROJECT_GRΣΤΟΝ Τ.Λ. 03 ΛΑΡΙΣΑΣPROJECT_GRΣΤΟΝ Τ.Λ. 03 ΛΑΡΙΣΑΣ
46PROJECT_ENGDISTRIBUTION NETWORKS AND SERVICE LINES AT O.S. 03 OF LARISAPROJECT_ENGDISTRIBUTION NETWORKS AND SERVICE LINES AT O.S. 03 OF LARISA
47G.P. GRΟΡΙΖΟΝΤΙΟΓΡΑΦΙΑ ΣΤΗΝ ΟΔΟ ΠΕΤΡΟΠΟΥΛΟΥ G.P. GRΟΡΙΖΟΝΤΙΟΓΡΑΦΙΑ ΣΤΗΝ ΟΔΟ ΠΕΤΡΟΠΟΥΛΟΥ
48G.P. ENGGROUND PLAN OF 10 PETROPOULOU STREETG.P. ENGGROUND PLAN OF 10 PETROPOULOU STREET
49AS BUILIT NoLAR.LP-GP/063-03-B-8903-CP38729/08.21AS BUILIT NoLAR.LP-GP/063-03-B-8903-CP38729-UR/08.21
50FILE NAME03B890311-CP38729.DWGFILE NAME03B890311-CP38729-UR.DWG
51
52
53A\AΣΤΑΣΗΧΥHΟΔΟΣΤ.ΛΚΩΔ. ΣΧΕΔΙΟΥΠΟΛΗ
541S1362493.4334387086.24978.50ΠΕΤΡΟΠΟΥΛΟΥ 100303B890311-CP38729.DWGΛΑΡΙΣΑ
FORMULAS
Cell Formulas
RangeFormula
H23H23=TODAY()
Cells with Data Validation
CellAllowCriteria
A17:A18List=LISTS!$I$2:$I$3


Overview Sheet
SL_THESS - Copy.xlsm
ABCDEFGHIJKLMNOPQR
1
2ΑναζήτησηΕπόμενη καταχώρηση
34UNDERGROUND RISER
4
5Ημ/νία κατασκευής
631/8/2021
7ΠόληΔιεύθυνσηΑριθμόςSplit NoCPJAΜΗΚΟΣ ΑΓΩΓΟΥΔιατομή
8ΛΑΡΙΣΑΠΕΤΡΟΠΟΥΛΟΥ 101CP387295.36Φ32
9CPΔιατομήΔιατομήΔιατομή
10CP38729Φ3203B890311-CP38729-UR.DWGLAR.LP-GP/063-03-B-8903-CP38729-UR/08.21
11JAΔΠ
12JA-21-033196ΔΠ-210009
13Τ.Λ.
14Τομέας Λειτουργίας 03ΣΤΟΝ Τ.Λ. 03 ΛΑΡΙΣΑΣ
15Κωδικός παροχήςΚωδικός αγωγούΚωδικός αρχείου
16032-03-S-CP38729063-03-B-890303B890311-CP38729
17Κωδικός έργουΌνομα αρχείου
18LAR.LP-GP/063-03-B-8903-CP38729/08.2103B890311-CP38729.DWG
19
20COPY - PASTE X,Y ΑΠΌ COMMAND LINE ΤΟΥ AYTOCAD
21X = 362493.433 Y = 4387086.249
22A/AΣΤΑΣΗ
231S1
24ΧΥΥ
25362493.4334387086.24978.50
26Οδός
27ΠΕΤΡΟΠΟΥΛΟΥ 10
28Τ.Λ.Πόλη
2903ΛΑΡΙΣΑ
30Όνομα αρχείου
3103B890311-CP38729.DWG
32
OVERVIEW
Cell Formulas
RangeFormula
D3D3=LISTS!AS2
B6B6=LISTS!AW2
B8B8=FORMULAS!A5
D8D8=FORMULAS!B20
F8:G8F8=FORMULAS!C20
L8L8=FORMULAS!I2
P8P8=FORMULAS!E23
B10B10=FORMULAS!I2
D10D10=FORMULAS!E17
L10L10=FORMULAS!E50
N10N10=FORMULAS!$I$12
B12B12=FORMULAS!B2
D12D12=FORMULAS!C2
B14B14=FORMULAS!E5
D14D14=FORMULAS!F5
B16,B18B16=FORMULAS!I3
D16D16=FORMULAS!A11
F16,F18F16=FORMULAS!I4
B23B23=FORMULAS!$A$54
C23C23=FORMULAS!$B$54
B25B25=FORMULAS!$C$54
C25C25=FORMULAS!$D$54
B27B27=FORMULAS!$F$54
B29B29=FORMULAS!$G$54
C29C29=FORMULAS!$I$54
B31B31=FORMULAS!$H$54
Cells with Conditional Formatting
CellConditionCell FormatStop If True
D8Expression=ISERROR(FORMULAS!$B$20)textNO
F8Expression=ISERROR(FORMULAS!$C$20)textNO
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
You must log in or register to reply here.

Similar threads

I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
223
Insurance Dave
I
S
  • Solved
For each row, create new folder based on single cell value, then save exported XML doc to matching folder.
Replies
3
Views
166
shand
S
M
  • Solved
save files as PDF for one sheet and create folders based on cell value
Replies
6
Views
451
Maklil
M
A
  • Question
create report for 40000 rows to calculation stock across sheet based on sheet name in cell value
Replies
1
Views
155
Amer Omar
A
D
  • Question
Copy rows to a new workbook based on a date range of last three months from today()
Replies
8
Views
310
dandee14k
D

Forum statistics

Threads
1,214,918
Messages
6,122,255
Members
449,075
Latest member
staticfluids

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