Please suggest solution outofbox (1 Viewer)

[zezo2021]

Hello
I have 2 column
one column is full with text and the other column is blank
the column full is contain type of food and under type of food there is category for example breakfast , lunch or dinner


Foods
----------------
juice
apple
tea
beans
====
breakfast category

bull meat

steak meat
=======
lunch category

bizza
fish
dinner category

my unsual question is
can i copy type of meals category beside the food not underd it in the empty column

 

[MajP]

What is this data and why is it in this format? If this is some kind of wacky import then clean it up before entry.
If I understand you have this ridiculous set of data and want to make it look like

FoodType	Category
Juice	Breakfast
apple	Breakfast
tea	Breakfast
Beans	Breakfast
steak Meat	lunch
bull meat	lunch

Simply
loop a recordset from last record to first
if foodtype column = ==== then next record is new category
update column Category with category Name
set Category name in foodtype column to null

 

[zezo2021]

What is this data and why is it in this format? If this is some kind of wacky import then clean it up before entry.
If I understand you have this ridiculous set of data and want to make it look like

FoodType	Category
Juice	Breakfast
apple	Breakfast
tea	Breakfast
Beans	Breakfast
steak Meat	lunch
bull meat	lunch

Simply
loop a recordset from last record to first
if foodtype column = ==== then next record is new category
update column Category with category Name
set Category name in foodtype column to null

Can you please write the code for me if possible

Thank you so much

 

[June7]

Provide accurate data sample. Does field really have === characters? You do not show it above dinner category.

If you want to attach file, follow instructions at bottom of my post.

 

[MajP]

I have to see a real sample. To see what really separates a category from food type. Not even sure if the ==== is real or just your way of showing an example

 

[zezo2021]

Provide accurate data sample. Does field really have === characters? You do not show it above dinner category.

If you want to attach file, follow instructions at bottom of my post.

 

[MajP]

This is in an Access forum, so is this to be done in Access or Excel? Is this a reoccurring import from Excel. Do you want and Excel Macro to do this in Excel or are you looking to import first into Access and then run an update query? If this is a one time fix in Excel I would think you could do that manually in less time then it took me to type this response.

 

[Pat Hartman]

Can you please write the code for me if possible

How much are you offering to pay for this job? The experts here are not your employees. They are all volunteers. Some have too much time on their hands so you'll probably get someone to work for you for nothing.

 

[June7]

Don't provide data as image. Build a table in post or attach data file (Excel, Access, CSV)

 

[MajP]

Public Sub DoSomethingStupid()
  'Your names here
  Const TableName = "TblOne"
  Const ItemField = "MenuItem"
  Const CategoryField = "Category"
  Const MenuItemLabel = "Menu Item Name"

  Dim strSql As String
  Dim rs As DAO.Recordset
  Dim Category As String

  'Delete  "Menu Item Name, Nulls, --------
  strSql = "Delete * from " & TableName & " WHERE " & ItemField & " IS NULL OR " & ItemField & " = '" & MenuItemLabel & "' OR " & ItemField & " LIKE '*--*'"
  Debug.Print strSql
  CurrentDb.Execute strSql
'you would have to import into a table and hopefully the order remains the same
  strSql = "Select * from " & TableName & " order By ID"
  Set rs = CurrentDb.OpenRecordset(strSql)
'Find the categorys following  *====* and update the category fields
  Do
    rs.FindNext ItemField & " like '*==*'"
    If Not rs.NoMatch Then
      rs.MoveNext
      Category = rs.Fields(ItemField)
      rs.Edit
        rs.Fields(CategoryField) = Category
      rs.Update
    End If
   Debug.Print rs.Fields(ItemField)
  Loop While rs.NoMatch = False

  'Delete the ==== field
  strSql = "Delete * from " & TableName & " WHERE " & ItemField & " like '*==*'"
  Debug.Print strSql
  CurrentDb.Execute strSql
 
  'start at end find a category and update until a new category
  rs.MoveLast
  Do While Not rs.BOF
    If rs.Fields(CategoryField) <> Category Then Category = rs.Fields(CategoryField)
    rs.Edit
      rs.Fields(CategoryField) = Category
    rs.Update
    rs.MovePrevious
  Loop

  'Get rid of the category name in menu item
  strSql = "(Select Distinct " & CategoryField & " From " & TableName & ")"
  Debug.Print strSql
  strSql = "Delete * from " & TableName & " WHERE " & ItemField & " In " & strSql
  CurrentDb.Execute strSql
End Sub

tblOld tblOld

ID	menuItem
1​	Menu Item Name
2​	---------------
3​	A
4​	B
5​	C
6​	D
7​	===========
8​	Lunch/Dinner
9​
10​
11​	Menu Item Name
12​	---------------
13​	E
14​	F
15​	G
16​	H
17​	==========
18​	Breakfeast
19​
20​
21​	Menu Item Name
22​	I
23​	J
24​	K
25​	L
26​	=========
27​	Soup of the Date

output
tblOne tblOne

ID	menuItem	Category
3​	A	Lunch/Dinner
4​	B	Lunch/Dinner
5​	C	Lunch/Dinner
6​	D	Lunch/Dinner
13​	E	Breakfeast
14​	F	Breakfeast
15​	G	Breakfeast
16​	H	Breakfeast
22​	I	Soup of the Day
23​	J	Soup of the Day
24​	K	Soup of the Day
25​	L	Soup of the Day

 

[zezo2021]

Public Sub DoSomethingStupid()
  'Your names here
  Const TableName = "TblOne"
  Const ItemField = "MenuItem"
  Const CategoryField = "Category"
  Const MenuItemLabel = "Menu Item Name"

  Dim strSql As String
  Dim rs As DAO.Recordset
  Dim Category As String

  'Delete  "Menu Item Name, Nulls, --------
  strSql = "Delete * from " & TableName & " WHERE " & ItemField & " IS NULL OR " & ItemField & " = '" & MenuItemLabel & "' OR " & ItemField & " LIKE '*--*'"
  Debug.Print strSql
  CurrentDb.Execute strSql
'you would have to import into a table and hopefully the order remains the same
  strSql = "Select * from " & TableName & " order By ID"
  Set rs = CurrentDb.OpenRecordset(strSql)
'Find the categorys following  *====* and update the category fields
  Do
    rs.FindNext ItemField & " like '*==*'"
    If Not rs.NoMatch Then
      rs.MoveNext
      Category = rs.Fields(ItemField)
      rs.Edit
        rs.Fields(CategoryField) = Category
      rs.Update
    End If
   Debug.Print rs.Fields(ItemField)
  Loop While rs.NoMatch = False

  'Delete the ==== field
  strSql = "Delete * from " & TableName & " WHERE " & ItemField & " like '*==*'"
  Debug.Print strSql
  CurrentDb.Execute strSql

  'start at end find a category and update until a new category
  rs.MoveLast
  Do While Not rs.BOF
    If rs.Fields(CategoryField) <> Category Then Category = rs.Fields(CategoryField)
    rs.Edit
      rs.Fields(CategoryField) = Category
    rs.Update
    rs.MovePrevious
  Loop

  'Get rid of the category name in menu item
  strSql = "(Select Distinct " & CategoryField & " From " & TableName & ")"
  Debug.Print strSql
  strSql = "Delete * from " & TableName & " WHERE " & ItemField & " In " & strSql
  CurrentDb.Execute strSql
End Sub

tblOld tblOld

ID	menuItem
1​	Menu Item Name
2​	---------------
3​	A
4​	B
5​	C
6​	D
7​	===========
8​	Lunch/Dinner
9​
10​
11​	Menu Item Name
12​	---------------
13​	E
14​	F
15​	G
16​	H
17​	==========
18​	Breakfeast
19​
20​
21​	Menu Item Name
22​	I
23​	J
24​	K
25​	L
26​	=========
27​	Soup of the Date

output
tblOne tblOne

ID	menuItem	Category
3​	A	Lunch/Dinner
4​	B	Lunch/Dinner
5​	C	Lunch/Dinner
6​	D	Lunch/Dinner
13​	E	Breakfeast
14​	F	Breakfeast
15​	G	Breakfeast
16​	H	Breakfeast
22​	I	Soup of the Day
23​	J	Soup of the Day
24​	K	Soup of the Day
25​	L	Soup of the Day

Thank you so much for your efforts


I run the code, but this error appears to me


-----
another question

what should I put on this const

Const MenuItemLabel = "Menu Item Name"

 

[zezo2021]

The Code error message

 

[MajP]

See example and updated code
subFrmOne subFrmOne

I added a requery before that error. You cannot open a recordset and then delete from the source. I mistakenly did that. Without the requery you have a "deleted" record.

The example allows you to reset the data and rerun it.
You have a Value "Menu Item Name" that is the constant. But since this is an example maybe it is something different. I have to delete all blank, ----, ====, and "Menu Item Name" values.